Extrait les pièces jointes msg de Outlook email

Question

J'ai le code vba suivant qui enregistre les pièces jointes dans un e-mail.

Cela fonctionne très bien pour .docx, .jpg etc. mais je dois l'utiliser pour extraire plusieurs pièces jointes .msg qui ne fonctionnent pas.

Le code est

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 
Dim objAtt As Outlook.Attachment 
Dim saveFolder As String 

saveFolder = "C:\Test\" 
For Each objAtt In itm.Attachments 
stFileName = saveFolder & "\" & objAtt.DisplayName 
i = 0 
JumpHere: 
If Dir(stFileName) = "" Then 
objAtt.SaveAsFile stFileName 
Else 
i = i + 1 
stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName 
GoTo JumpHere 
End If 
Set objAtt = Nothing 
Next 
End Sub 

L'erreur concerne la ligne - Si Dir (stFileName) = "" Alors

Answer 1

Après notre chat, voici le code final:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem) 
Dim objAtt As Outlook.Attachment 
Dim saveFolder As String 
Dim i As Integer 

saveFolder = "C:\Test\" 
For Each objAtt In itm.Attachments 
    stFileName = saveFolder & objAtt.FileName 
    i = 0 
    'Loop to find the first available filename 
    Do While Dir(stFileName) <> "" 
    i = i + 1 
    stFileName = saveFolder & i & " - " & objAtt.FileName 
    Loop 
    objAtt.SaveAsFile stFileName 
Next 
End Sub 

Cordialement,

Max