Outlookのメールからmsg添付ファイルを抽出する

Question

添付ファイルを電子メールに保存する次のvbaコードがあります。

これは.docx、.jpgなどでうまく動作しますが、動作しない複数の.msg添付ファイルを抽出するために使用する必要があります。

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 

： -

コードが

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 

でエラーがラインに関係するディレクトリ（stFileName）場合は= "" その後

Answer 1

を私たちのチャットに続き、ここでの最終的なコードですよろしく、

最大