Outlook VBA methode Range
thefloflo64
Messages postés
663
Date d'inscription
Statut
Membre
Dernière intervention
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je souhaite exécuter une macro via Outlook permettant de récupérer des bêlements d'un mail puis de les intégrer dans un fichier Excel. Une fois sur deux les informations ne sont pas rempli car celui ci ne comprend pas la méthode "Range".
il faut a chaque fois fermer Outlook et cela refonctionne de nouveau pour une seule exécution (il faut toujours fermer et re ouvrir Outlook) .
Est ce que quelqu'un aurait une solution ?
Merci d'avance
Cordialement,
Florian
Je souhaite exécuter une macro via Outlook permettant de récupérer des bêlements d'un mail puis de les intégrer dans un fichier Excel. Une fois sur deux les informations ne sont pas rempli car celui ci ne comprend pas la méthode "Range".
il faut a chaque fois fermer Outlook et cela refonctionne de nouveau pour une seule exécution (il faut toujours fermer et re ouvrir Outlook) .
Range(Columns("A").Find(What:="", after:=Range("A1")).Address) = motValeurBloc
Range(Columns("B").Find(What:="", after:=Range("B1")).Address) = Msg.SentOn
Range(Columns("C").Find(What:="", after:=Range("C1")).Address) = motBloc
Est ce que quelqu'un aurait une solution ?
Merci d'avance
Cordialement,
Florian
2 réponses
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonsoir, il me semble que tu ne nous montres qu'une partie de ton code.
je me trompe?
es-tu certain que la solution est à faire dans cette partie?
ne penses-tu pas utile de nous préciser le message d'erreur précis que tu obtiens, et sur quelle ligne?
si ton analyse est correcte, il y a probablement quelque chose qui change entre la première exécution et l’exécution suivante. tu ne nous en montres pas assez pour que nous puissions comprendre ce qui change.
en règle générale, j'évite, même dans Excel, de faire des opérations sans préciser la feuille. alors, à fortiori, cela me semble risqué à partir de Outlook.-
Bonjour yg_be,
Merci de ta réponse rapide :)
Voici donc le code complet de ma macro :
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 Comptes de messagerie
Comptes_messagerie = Array("mail@mail.com")
'balayage Dossiers Outlook
For Each Dossier In olApp.GetNamespace("MAPI").Folders
If UBound(Filter(Comptes_messagerie, Dossier.Name)) > -1 Then
'assignation évenements 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 Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim texte As String, mots() As String, mot As String
If TypeName(item) = "MailItem" Then
Set Msg = item
Dim ExApp As Excel.Application
Dim ExWbk As Workbook
texte = Msg.Body
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" Then
mots = Split(texte, "remise a ")
mots = Split(mots(1), " de la ressource")
mot = Trim(mots(0))
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" & "*Hebdo*" Then
motsQR = Split(texte, "de la ressource ")
motsQR = Split(motsQR(1), " reboot Hebdo")
motQR = Trim(motsQR(0))
Set ExApp = New Excel.Application
Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\debloc.xlsx")
ExApp.Visible = True
'Sheets("debloc").Activate
ActiveWorkbook.Range(Columns("A").Find(What:="", after:=Range("A1")).Address) = motQR
ActiveWorkbook.Range(Columns("B").Find(What:="", after:=Range("B1")).Address) = Msg.SentOn
ActiveWorkbook.Range(Columns("C").Find(What:="", after:=Range("C1")).Address) = mot
ActiveWorkbook.Close SaveChanges:=True
Exit Sub
End If
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" Then
motsQR = Split(texte, "de la ressource ")
motsQR = Split(motsQR(1), " dans le cadre")
motQR = Trim(motsQR(0))
Set ExApp = New Excel.Application
Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\debloc.xlsx")
ExApp.Visible = True
'Sheets("debloc").Activate
Range(Columns("A").Find(What:="", after:=Range("A1")).Address) = motQR
Range(Columns("B").Find(What:="", after:=Range("B1")).Address) = Msg.SentOn
Range(Columns("C").Find(What:="", after:=Range("C1")).Address) = mot
ActiveWorkbook.Close SaveChanges:=True
Exit Sub
End If
End If
texte = Msg.Body
If Msg.Body Like "*BLOCAGE*" & "*QR*" Then
motsBloc = Split(texte, "mise a ")
motsBloc = Split(motsBloc(1), " de la ressource")
motBloc = Trim(motsBloc(0))
If Msg.Body Like "*BLOCAGE*" & "*QR*" Then
motsValeurBloc = Split(texte, "de la ressource ")
motsValeurBloc = Split(motsValeurBloc(1), " dans le cadre")
motValeurBloc = Trim(motsValeurBloc(0))
Set ExApp = New Excel.Application
Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\bloc.xlsx")
ExApp.Visible = True
'Sheets("bloc").Activate
Range(Columns("A").Find(What:="", after:=Range("A1")).Address) = motValeurBloc
Range(Columns("B").Find(What:="", after:=Range("B1")).Address) = Msg.SentOn
Range(Columns("C").Find(What:="", after:=Range("C1")).Address) = motBloc
ActiveWorkbook.Close SaveChanges:=True
Exit Sub
End If
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
ProgramExit:
'Exit Sub
'ErrorHandler:
'MsgBox Err.Number & " - " & Err.Description
'Resume ProgramExit
End Sub
A mon sens l'erreur vient bel et bien de la partie que j'ai cité plus haut.
Néanmoins, je ne suis infaillible :)
Est-ce que cela peut t'aider d'avantage ?
Cordialement,
Florian -
-
-
as-tu l'erreur simultanément sur les trois instructions?
moi j'essaierais, pour éviter de faire des opérations sans préciser la feuille:Dim ExSheet As Worksheet Set ExSheet = ExWbk.Worksheets("bloc") Range(ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1")).Address) = motValeurBloc -
Bonjour,
Je vous copie le code modifié:
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 Comptes de messagerie
Comptes_messagerie = Array("mail@mail.com")
'balayage Dossiers Outlook
For Each Dossier In olApp.GetNamespace("MAPI").Folders
If UBound(Filter(Comptes_messagerie, Dossier.Name)) > -1 Then
'assignation évenements 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 Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim texte As String, mots() As String, mot As String
If TypeName(item) = "MailItem" Then
Set Msg = item
Dim ExApp As Excel.Application
Dim ExWbk As Workbook
Dim ExSheet As Worksheet
texte = Msg.Body
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" Then
mots = Split(texte, "remise a ")
mots = Split(mots(1), " de la ressource")
mot = Trim(mots(0))
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" & "*Hebdo*" Then
motsQR = Split(texte, "de la ressource ")
motsQR = Split(motsQR(1), " reboot Hebdo")
motQR = Trim(motsQR(0))
Set ExApp = New Excel.Application
Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\debloc.xlsx")
ExApp.Visible = True
'Sheets("debloc").Activate
Set ExSheet = ExWbk.Worksheets("debloc")
Range(ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1")).Address) = motQR
Range(ExSheet.Columns("B").Find(What:="", after:=ExSheet.Range("B1")).Address) = Msg.SentOn
Range(ExSheet.Columns("C").Find(What:="", after:=ExSheet.Range("C1")).Address) = mot
ActiveWorkbook.Close SaveChanges:=True
Exit Sub
End If
If Msg.Body Like "*DEBLOCAGE*" & "*QR*" Then
motsQR = Split(texte, "de la ressource ")
motsQR = Split(motsQR(1), " dans le cadre")
motQR = Trim(motsQR(0))
Set ExApp = New Excel.Application
Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\debloc.xlsx")
ExApp.Visible = True
'Sheets("debloc").Activate
Set ExSheet = ExWbk.Worksheets("debloc")
Range(ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1")).Address) = motQR
Range(ExSheet.Columns("B").Find(What:="", after:=ExSheet.Range("B1")).Address) = Msg.SentOn
Range(ExSheet.Columns("C").Find(What:="", after:=ExSheet.Range("C1")).Address) = mot
ActiveWorkbook.Close SaveChanges:=True
Exit Sub
End If
End If
texte = Msg.Body
If Msg.Body Like "*BLOCAGE*" & "*QR*" Then
motsBloc = Split(texte, "mise a ")
motsBloc = Split(motsBloc(1), " de la ressource")
motBloc = Trim(motsBloc(0))
If Msg.Body Like "*BLOCAGE*" & "*QR*" Then
motsValeurBloc = Split(texte, "de la ressource ")
motsValeurBloc = Split(motsValeurBloc(1), " dans le cadre")
motValeurBloc = Trim(motsValeurBloc(0))
Set ExApp = New Excel.Application
Set ExWbk = ExApp.Workbooks.Open("C:\Users\o_gob\Desktop\QR\bloc.xlsx")
ExApp.Visible = True
'Sheets("bloc").Activate
Set ExSheet = ExWbk.Worksheets("bloc")
Range(ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1")).Address) = motValeurBloc
Range(ExSheet.Columns("B").Find(What:="", after:=ExSheet.Range("B1")).Address) = Msg.SentOn
Range(ExSheet.Columns("C").Find(What:="", after:=ExSheet.Range("C1")).Address) = motBloc
ActiveWorkbook.Close SaveChanges:=True
Exit Sub
End If
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
ProgramExit:
'Exit Sub
'ErrorHandler:
'MsgBox Err.Number & " - " & Err.Description
'Resume ProgramExit
End Sub
Lorsque je m'envoie un mail, et que je ferme Outlook a chaque envoie de mail cela fonctionne très bien. Si je m'envoie en continue deux mails sans fermer entre temps Outlook pour le re ouvrir j'ai un message d'erreur qui apparaît.
" Erreur d'execution '1004': La methode 'Range de l'objet'_Global' a échoué "
Merci d'avance,
Florian
-
-
Bonjour,
Je dissocierai vos instructions en 2:
Set cell = ExSheet.Columns("A").Find(What:="", after:=ExSheet.Range("A1"))
cell.Value = motQR
Par ailleurs, ceci éviterait de garder des instances d'applications Excel en mémoire
ActiveWorkbook.Save
ExApp.Quit
