Question

我有以下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

该错误涉及该行 - 如果Dir（stFileName）=“”那么

Answer 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

此致

最高

从Outlook电子邮件中提取msg附件

1 个答案: