thefloflo64
Messages postés663Date d'inscriptionjeudi 13 novembre 2014StatutMembreDernière intervention28 novembre 2017
-
29 août 2017 à 10:09
thefloflo64
Messages postés663Date d'inscriptionjeudi 13 novembre 2014StatutMembreDernière intervention28 novembre 2017
-
30 août 2017 à 10:14
Bonjour,
J'ai l'erreur 91 concernant ma macro.
Je ne sais pas quoi faire pour arranger la situation.
L'erreur est sur l'enregistrement et la fermeture du fichier Excel.
Avez-vous une solution ?
Option Explicit
Private WithEvents myOlItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application Dim Comptes_messagerie() Dim Dossier As Outlook.MAPIFolder
'définition application Set olApp = Outlook.Application 'définition compte de messagerie Comptes_messagerie = Array("olivia.gobe@infotel.com") 'sélection dossiers Outlook a analyser For Each Dossier In olApp.GetNamespace("MAPI").Folders If UBound(Filter(Comptes_messagerie, Dossier.Name)) > -1 Then 'assignation évènements de la boîte de réception du Compte de messagerie Set myOlItems = Dossier.Folders("Boîte de réception").Items End If Next Dossier
End Sub
Private Sub myOlItems_ItemAdd(ByVal item As Object) 'On declare les varibles Dim Msg As Outlook.MailItem Dim texte As String, mots() As String, mot As String, motsQR() As String, motQR As String, motsBloc() As String, motBloc As String, motsValeurBloc() As String, motValeurBloc As String
If TypeName(item) = "MailItem" Then Set Msg = item Dim ExApp As Excel.Application Dim ExWbk As Workbook Dim ExSheet As Worksheet Dim cell As Range
texte = Msg.Body
'On regarde si dans le mail, il est écrit DEBLOCAGE et QR, si oui, 'on regarde dans le body du mail et on releve le mot entre 'mise a et de la ressource'
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" Then mots = Split(texte, "remise a ") mots = Split(mots(1), " de la ressource") mot = Trim(mots(0))
'On regarde si dans le mail, il est écrit DEBLOCAGE, QR et Hebdo, si oui, 'on regarde dans le body du mail et on releve le mot entre 'de la ressource à reboot hebdo
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" & "*Hebdo*" Then motsQR = Split(texte, "de la ressource ") motsQR = Split(motsQR(1), " reboot Hebdo") motQR = Trim(motsQR(0))
'On ouvre le fichier Excel debloc' Set ExApp = New Excel.Application Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\debloc.xlsx") ExApp.Visible = True
' On complete les colonnes du fichier excel debloc' Set ExSheet = ExWbk.Worksheets("debloc") 'On recherche parmis les lignes de la colonne, les emplacements vides Set cell = ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1")) cell.Value = motQR Set cell = ExSheet.Columns("B").Find(What:="", after:=ExSheet.Range("B1")) cell.Value = Msg.SentOn Set cell = ExSheet.Columns("C").Find(What:="", after:=ExSheet.Range("C1")) cell.Value = mot ThisWorkbook.Close SaveChanges:=True Exit Sub End If
'On regarde si dans le mail, il est écrit DEBLOCAGE, QR et Hebdo, si oui, 'on regarde dans le body du mail et on releve le mot entre 'de la ressource à reboot hebdo
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" Then motsQR = Split(texte, "de la ressource ") motsQR = Split(motsQR(1), " dans le cadre") motQR = Trim(motsQR(0))
'On ouvre le fichier debloc Set ExApp = New Excel.Application Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\debloc.xlsx") ExApp.Visible = True
'On complete le fichier debloc
Set ExSheet = ExWbk.Worksheets("debloc") Set cell = ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1")) cell.Value = motQR Set cell = ExSheet.Columns("B").Find(What:="", after:=ExSheet.Range("B1")) cell.Value = Msg.SentOn Set cell = ExSheet.Columns("C").Find(What:="", after:=ExSheet.Range("C1")) cell.Value = mot ThisWorkbook.Close SaveChanges = True Exit Sub End If End If
texte = Msg.Body
'On regarde si dans le mail, il est écrit BLOCAGE et QR 'si oui, regarde dans le body du mail et on releve le mot entre 'mise a et de la ressource
If Msg.Body Like "*BLOCAGE*" & "*QR*" Then motsBloc = Split(texte, "mise a ") motsBloc = Split(motsBloc(1), " de la ressource") motBloc = Trim(motsBloc(0))
'On regarde si il est écrit BLOCAGE et QR 'si oui, on regarde dans le body du mail et on relève le mot entre 'de la ressource et dans le cadre
If Msg.Body Like "*BLOCAGE*" & "*QR*" Then motsValeurBloc = Split(texte, "de la ressource ") motsValeurBloc = Split(motsValeurBloc(1), " dans le cadre") motValeurBloc = Trim(motsValeurBloc(0))
' On ouvre le fichier Excel' Set ExApp = New Excel.Application Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\bloc.xlsx") ExApp.Visible = True
'On complete dans le fichier bloc' Set ExSheet = ExWbk.Worksheets("bloc") Set cell = ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1")) cell.Value = motValeurBloc Set cell = ExSheet.Columns("B").Find(What:="", after:=ExSheet.Range("B1")) cell.Value = Msg.SentOn Set cell = ExSheet.Columns("C").Find(What:="", after:=ExSheet.Range("C1")) cell.Value = motBloc
ActiveWorkbook.Close SaveChanges:=True Exit Sub End If
'On regarde si dans le mail, il est écrit reboot si oui, 'on regarde dans le body du mail et on relève le mot 'entre de la ressource et reboot'
If Msg.Body Like "*reboot*" Then motsValeurBloc = Split(texte, "de la ressource ") motsValeurBloc = Split(motsValeurBloc(1), " reboot") motValeurBloc = Trim(motsValeurBloc(0))
End If End If End If
'On enregistre le fichier avant de quitter l'application ThisWorkbook.Close SaveChanges:=True ExApp.Quit
30 août 2017 à 10:14
Merci beaucoup ! c'était ça le problème.
Cordialement,
Florian