在 Outlook 中获取/打开邮件附件

Question

我正在尝试找到一种方法来获取邮件附件（以编程方式），然后打开它...有人可以告诉我如何执行此操作或为我指出正确的方向吗？

Answer 1

这是一个 VBA 脚本（在 Outlook 中的宏中使用），它将循环遍历当前文件夹中所有选定项目中的所有附件并将它们保存到磁盘。

它应该可以帮助您开始，并且我认为添加某种流程启动而不是向其保存逻辑并不需要太多。

 Public Sub SaveAttachments()

  'Note, this assumes you are in the a folder with e-mail messages when you run it.
  'It does not have to be the inbox, simply any folder with e-mail messages

  Dim Exp As Outlook.Explorer
  Dim Sel As Outlook.Selection

  Dim AttachmentCnt As Integer
  Dim AttTotal As Integer
  Dim MsgTotal As Integer

  Dim outputDir As String
  Dim outputFile As String
  Dim fileExists As Boolean
  Dim cnt As Integer

  'Requires reference to Microsoft Scripting Runtime (SCRRUN.DLL)
  Dim fso As FileSystemObject

  Set Exp = Application.ActiveExplorer

  Set Sel = Exp.Selection
  Set fso = New FileSystemObject

  outputDir = "C:\Path"
  If outputDir = "" Then
    MsgBox "You must pick an directory to save your files to. Exiting SaveAttachments.", vbCritical, "SaveAttachments"
    Exit Sub
  End If

   Dim att As Attachment

  'Loop thru each selected item in the inbox
  For cnt = 1 To Sel.Count
    'If the e-mail has attachments...
    If Sel.Item(cnt).Attachments.Count > 0 Then
      MsgTotal = MsgTotal + 1

      'For each attachment on the message...
      For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count
        'Get the attachment

        Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
        outputFile = att.FileName

        outputFile = Format(Sel.Item(cnt).ReceivedTime, "yyyy-mm-dd_hhmmss - ") + outputFile

        fileExists = fso.fileExists(outputDir + outputFile)

        'Save it to disk if the file does not exist
        If fileExists = False Then
          att.SaveAsFile (outputDir + outputFile)
          AttTotal = AttTotal + 1
        End If

        Set att = Nothing

        Sel.Item(cnt).Close (Outlook.OlInspectorClose.olDiscard)

      Next
    End If
  Next

  'Clean up
  Set Sel = Nothing
  Set Exp = Nothing
  Set fso = Nothing

  'Let user know we are done
  Dim doneMsg As String
  doneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments in " + Format$(MsgTotal, "#,0") + " Messages."
  MsgBox doneMsg, vbOKOnly, "Save Attachments"

  Exit Sub

ErrorHandler:

  Dim errMsg As String
  errMsg = "An error has occurred. Error " + Err.Number + " " + Err.Description
  Dim errResult As VbMsgBoxResult
  errResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save Attachments")
  Select Case errResult
    Case vbAbort
      Exit Sub

    Case vbRetry
      Resume

    Case vbIgnore
      Resume Next

  End Select

End Sub

Answer 2

查找 Outlook 的 COM 引用。
您还可以使用用 vba 编写的宏来执行此操作。