Сохранить вложение 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. Затем в своем месте назначьте itemobjMsg, чтобы остальная часть скрипта функционировала нормально. После тестирования я решил украсть его и использовать его сам.

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