1

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

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

コードは

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

エラーは次の行に関するものです - If Dir(stFileName) = "" Then

4

1 に答える 1

1

チャットに続いて、最終的なコードは次のとおりです。

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

よろしく、

マックス

于 2011-06-30T17:07:30.903 に答える