[Excel] macro outlook ne traite jamais dernier mail sauf si un seul

macro outlook ne traite jamais dernier mail sauf si un seul [Excel] - VB/VBA/VBS - Programmation

Marsh Posté le 20-06-2017 à 12:17:27    

Bonjour à tous,
 
clairement je galère, je suis en train de créer une macro sous excel qui va récupérer des fichiers xml reçus en PJ de mail.
lorsque j’exécute cette macro tout va bien:

Code :
  1. Sub test()
  2. Application.Calculation = xlManual
  3. Application.ScreenUpdating = False
  5. Dim myOlApp As Outlook.Application
  6. Dim myNameSpace As Object
  7. Dim myInbox As Object
  8. Dim DossierSource As Object
  9. Dim DossierTraite As Object
  10. Dim myItem As Object, myAttachments As Object
  11. Dim RepSauv As String
  12. Dim ExtFich As String
  14. Set myOlApp = CreateObject("Outlook.Application" )
  15. Set myNameSpace = myOlApp.GetNamespace("MAPI" )
  16. Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
  17. Set DossierSource = myInbox.Folders("XML" )
  18. Set DossierTraite = myInbox.Folders("XML" ).Folders("Traités" )
  19. RepSauv = "C:\XML\test\"
  21. For Each myItem In DossierSource.Items
  22.     Set myAttachments = myItem.Attachments
  23.         If myAttachments.Count > 0 Then
  24.             'for all attachments do...
  25.             For i = 1 To myAttachments.Count
  26.             ExtFich = Mid(myAttachments(i), InStrRev(myAttachments(i), "." ) + 1)
  27.                 If ExtFich = "xml" Then
  28.                    'save them to destination
  29.                     myAttachments(i).SaveAsFile RepSauv & myAttachments(i).DisplayName
  30.                 End If
  31.             Next i
  32.         End If
  33.     'Set myItem = myItem.Move(DossierTraite) (Ignorée car me pose Pb)
  34. Next
  36. Application.Calculation = xlAutomatic
  38. End Sub


 
il récupère bien que les XML des mails dans le répertoire défini.
 
Par contre dès que j'active cette ligne dans mon code pour déplacer le mail traité dans le sous répertoire "traités":

Code :
  1. Set myItem = myItem.Move(DossierTraite)


A chaque fois il me zappe un mail, il ne le traite pas du tout, comme s'il n'existait pas, et quand je relance à nouveau la macro là il le traite.
Je ne comprends pas pourquoi?!? :pt1cable: Et c'est systématiquement le dernier mail de la liste qu'il ne traite pas.
 
Help me  :hello:


Message édité par wago le 20-06-2017 à 12:21:56
Reply

Marsh Posté le 20-06-2017 à 12:17:27   

Reply

Marsh Posté le 21-06-2017 à 10:38:41    

 
            Bonjour,
 
            pourquoi Set myItem = ?!    Quel intérêt ?
 

Reply

Marsh Posté le 21-06-2017 à 19:52:23    

J'ai pris ce bout de code sur un forum. J'ai essayé sans mais ça ne fonctionne pas, ça me renvoie une erreur.

Reply

Marsh Posté le 23-06-2017 à 14:46:35    

 
            C'est bien là le problème : Copier / Coller n'est pas coder …
 
            Comme la variable est celle utilisée par la boucle, il ne faut surtout pas la modifier au sein de cette boucle !
            Es-tu sûr au moins que le code copié fonctionne déjà là où tu l'as pris ?!   Car tel quel, j'en doute fort …
 

Message cité 1 fois
Reply

Marsh Posté le 04-07-2017 à 22:10:31    

Marc L a écrit :

 
            C'est bien là le problème : Copier / Coller n'est pas coder …
 
            Comme la variable est celle utilisée par la boucle, il ne faut surtout pas la modifier au sein de cette boucle !
            Es-tu sûr au moins que le code copié fonctionne déjà là où tu l'as pris ?!   Car tel quel, j'en doute fort …
 


 
Je croyais être sur un forum d'entre aide pas de leçon... Bref j'ai trouvé comment faire, en rejouant tout bêtement en boucle le déplacement tant qu'il y a des mails dans le répertoire concerné.
Si ça intéresse qqn:
 

Code :
  1. Sub DEPLACEMENT()
  2. 'Macro de déplacement des emails traités vers le repertoire "Traités" de la bal outlook
  4.     Application.ScreenUpdating = False
  6. 'Déclaration des variables
  7.     Dim MyOlapp As Object
  8.     Dim myNameSpace As Object
  9.     Dim myInbox As Object
  10.     Dim myDestFolder As Object
  11.     Dim myItems As Outlook.Items
  12.     Dim myItem As Object
  13. On Error GoTo err
  14. 'Deplace chaque mail vers le repertoire traité de la boite mail
  15. deplace:
  16.     Set MyOlapp = CreateObject("Outlook.Application" )
  17.     Set myNameSpace = MyOlapp.GetNamespace("MAPI" )
  18.     Set myInbox = myNameSpace.Folders("Ma boite de fonction" ).Folders("Boîte de réception" ).Folders("XML" )
  19.     Set myItems = myInbox.Items
  20.     Set myDestFolder = myNameSpace.Folders("Ma boite de fonction" ).Folders("Boîte de réception" ).Folders("XML" ).Folders("Traités" )
  21.     For Each myItem In myItems
  22.     myItem.Move myDestFolder
  23.     Next
  25. 'Teste la présence de mail dans le repertoire xml, s'il reste des mail rejoue le bloc du dessus
  26. testmail:
  27.     Dim EmailCount As Integer
  28.     EmailCount = myInbox.Items.Count
  29.         If EmailCount > 0 Then
  30.             GoTo deplace
  31.         End If
  32.     Exit Sub
  33. err:
  34. MsgBox ("Une erreur est survenue." & Chr(10) & "Il se peut que:" & Chr(10) & " -Outlook ne soit pas executé" & Chr(10) & " -Le repertoire XML n'existe pas" )
  35. End Sub


 
Merci quand meme  :hello:


Message édité par wago le 04-07-2017 à 22:11:14
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed