将Outlook附件保存到磁盘

Question

我发现众多 VBA脚本自动将附件移动到我的硬盘上的示例。当我在Outlook中运行宏时，我在网上找到了这个工程，但在将其设置为规则时不起作用。

当我在子标题中没有“item as outlook.mailitem”参数的情况下运行宏，并让电子邮件包含我要保存的文件时，它将正常运行。

但是，只要我添加该信息以便我可以按规则运行它，outlook将引发错误并禁用该规则。

Option Explicit 

Public Sub moveAttachmentsAlpha(item As Outlook.MailItem) 

Dim objOL As Outlook.Application 
Dim objMsg As Outlook.MailItem 'Object 
Dim objAttachments As Outlook.Attachments 
Dim objSelection As Outlook.Selection 
Dim i As Long 
Dim lngCount As Long 
Dim strFile As String 
Dim strFolderpath As String 
Dim strDeletedFiles As String 

' Get the path to your My Documents folder 
strFolderpath = "C:\DailyFlash\" 
On Error Resume Next 

' Instantiate an Outlook Application object. 

Set objOL = CreateObject("Outlook.Application") 

' Get the collection of selected objects. 
Set objSelection = objOL.ActiveExplorer.Selection 

' Check each selected item for attachments. If attachments exist, 
' save them to the strFolderPath folder and strip them from the item. 
For Each objMsg In objSelection 

' This code only strips attachments from mail items. 
' If objMsg.class=olMail Then 
' Get the Attachments collection of the item. 
Set objAttachments = objMsg.Attachments 
lngCount = objAttachments.Count 
strDeletedFiles = "" 

If lngCount > 0 Then 

' We need to use a count down loop for removing items 
' from a collection. Otherwise, the loop counter gets 
' confused and only every other item is removed. 

    For i = lngCount To 1 Step -1 

     ' Save attachment before deleting from item. 
     ' Get the file name. 
     strFile = objAttachments.item(i).FileName 

    ' Combine with the path to the Temp folder. 
    strFile = strFolderpath & strFile 

    ' Save the attachment as a file. 
    objAttachments.item(i).SaveAsFile strFile 

    'write the save as path to a string to add to the message 
    'check for html and use html tags in link 
    If objMsg.BodyFormat <> olFormatHTML Then 
     strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
     Else 
     strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
     strFile & "'>" & strFile & "</a>" 
    End If 

    'Use the MsgBox command to troubleshoot. Remove it from the final code. 
    'MsgBox strDeletedFiles 

Next i 

' Adds the filename string to the message body and save it 
' Check for HTML body 
If objMsg.BodyFormat <> olFormatHTML Then 
    objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
Else 
    objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
End If 
    objMsg.Save 
End If 
Next 

ExitSub: 

Set objAttachments = Nothing 
Set objMsg = Nothing 
Set objSelection = Nothing 
Set objOL = Nothing 

End Sub 

Answer 1

保留大部分脚本。删除对Outlook.Selection和与其关联的for循环的引用。然后，在它的位置，将item指定为objMsg以允许脚本的其余部分正常工作。经过测试，我决定偷走它并自己使用它。

Public Sub moveAttachmentsAlpha(item As Outlook.MailItem) 

Dim objMsg As Outlook.MailItem 'Object 
Dim objAttachments As Outlook.Attachments 
Dim i As Long 
Dim lngCount As Long 
Dim strFile As String 
Dim strFolderpath As String 
Dim strDeletedFiles As String 

' Get the path to your My Documents folder 
strFolderpath = "C:\temp\" 
On Error Resume Next 

Set objMsg = item 

' This code only strips attachments from mail items. 
' If objMsg.class=olMail Then 
' Get the Attachments collection of the item. 
Set objAttachments = objMsg.Attachments 
lngCount = objAttachments.Count 
strDeletedFiles = "" 

If lngCount > 0 Then 

    ' We need to use a count down loop for removing items 
    ' from a collection. Otherwise, the loop counter gets 
    ' confused and only every other item is removed. 

    For i = lngCount To 1 Step -1 

     ' Save attachment before deleting from item. 
     ' Get the file name. 
     strFile = objAttachments.item(i).FileName 

     ' Combine with the path to the Temp folder. 
     strFile = strFolderpath & strFile 

     ' Save the attachment as a file. 
     objAttachments.item(i).SaveAsFile strFile 

     'write the save as path to a string to add to the message 
     'check for html and use html tags in link 
     If objMsg.BodyFormat <> olFormatHTML Then 
      strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
     Else 
      strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
      strFile & "'>" & strFile & "</a>" 
     End If 

    Next i 

    ' Adds the filename string to the message body and save it 
    ' Check for HTML body 
    If objMsg.BodyFormat <> olFormatHTML Then 
     objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
    Else 
     objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
    End If 
    objMsg.Save 
End If 

ExitSub: 

Set objAttachments = Nothing 
Set objMsg = Nothing 
Set objSelection = Nothing 
Set objOL = Nothing 

End Sub 

FYI：我行' This code only strips attachments from mail items.除了一个Next