Outlook VBA methode Range

Fermé

thefloflo64 Messages postés 650 Date d'inscription jeudi 13 novembre 2014 Statut Membre Dernière intervention 28 novembre 2017 - 22 août 2017 à 16:35
yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 - 25 août 2017 à 10:17

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) .

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

A voir également:

Outlook VBA methode Range
Compte outlook gratuit - Guide
Erreur 1001 outlook - Accueil - Bureautique
Synchroniser agenda google et outlook - Guide
Accusé de reception outlook - Guide
Nouveau outlook - Accueil - Mail

2 réponses

Réponse 1 / 2

yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 Ambassadeur 1 557
22 août 2017 à 21:36

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.

thefloflo64 Messages postés 650 Date d'inscription jeudi 13 novembre 2014 Statut Membre Dernière intervention 28 novembre 2017 93
23 août 2017 à 10:15

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

yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557 > thefloflo64 Messages postés 650 Date d'inscription jeudi 13 novembre 2014 Statut Membre Dernière intervention 28 novembre 2017
23 août 2017 à 10:33

ne penses-tu pas utile de nous préciser le message d'erreur précis que tu obtiens, et sur quelle ligne?

thefloflo64 Messages postés 650 Date d'inscription jeudi 13 novembre 2014 Statut Membre Dernière intervention 28 novembre 2017 93
23 août 2017 à 10:54

Erreur : '1004': Method Range of Object '_Global' Failed

sur les lignes que j'ai cité dans le message initial

Merci,
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

thefloflo64 Messages postés 650 Date d'inscription jeudi 13 novembre 2014 Statut Membre Dernière intervention 28 novembre 2017 93 > yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024
24 août 2017 à 09:46

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

Réponse 2 / 2

thev Messages postés 1925 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 18 décembre 2024 692
Modifié le 25 août 2017 à 10:14

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

yg_be Messages postés 23408 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 décembre 2024 1 557
25 août 2017 à 10:17

bonjour à tous.
thefloflo64, je suppose que tu as

option explicit

en haut de module, sinon je te suggère de l'y ajouter.
et donc aussi

dim cell as range

Discussions similaires

input signal out of range

VBA : Range avec références variables..

Postmaster outlook c'est quoi ???

comment désactiver out of range

Ecran noir avec 'out of range" sous windows 10