Outlook VBA methode Range

thefloflo64 Messages postés 663 Date d'inscription   Statut Membre Dernière intervention   -  
yg_be Messages postés 24281 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) . 


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

Réponse 1 / 2
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 585
 
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.
0
thefloflo64 Messages postés 663 Date d'inscription   Statut Membre Dernière intervention   93
 
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
0
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   1 585 > thefloflo64 Messages postés 663 Date d'inscription   Statut Membre Dernière intervention  
 
ne penses-tu pas utile de nous préciser le message d'erreur précis que tu obtiens, et sur quelle ligne?
0
thefloflo64 Messages postés 663 Date d'inscription   Statut Membre Dernière intervention   93
 
Erreur : '1004': Method Range of Object '_Global' Failed

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


Merci,
Florian
0
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   1 585 > thefloflo64 Messages postés 663 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
thefloflo64 Messages postés 663 Date d'inscription   Statut Membre Dernière intervention   93 > yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention  
 
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
0
Réponse 2 / 2
thev Messages postés 2073 Date d'inscription   Statut Membre Dernière intervention   717
 
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
0
yg_be Messages postés 24281 Date d'inscription   Statut Contributeur Dernière intervention   1 585
 
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
0

Discussions similaires

input signal out of range
marlene -
usman000 -

14 réponses
VBA : Range avec références variables..
Antoine -
MIKE59 -

7 réponses
Ecran noir avec 'out of range" sous windows 10
SAPHIR13600 -
SAPHIR13600 -

5 réponses
comment désactiver out of range
lzri98 -
jeannets -

3 réponses
Syntaxe VBA Sheets.Range avec Range variable
Nicoroth -
lermite222 -

17 réponses