VBA代碼，用於將附件（excel文件）保存在另一封電子郵件中作為附件的Outlook電子郵件中

Question

我有代碼保存特定Outlook文件夾中的郵件附件。

如果電子郵件包含附件，我的腳本將起作用，但如果電子郵件作為帶附件的附件發送，則無法使用 。

在這種情況下，我的電子郵件包含其他電子郵件作為附件（來自自動轉發規則）。 嵌入的電子郵件附件隨后包含excel文件。

請看下面我目前的vba ：

Public Sub SaveOlAttachments()
  Dim isAttachment As Boolean
  Dim olFolder As Outlook.MAPIFolder
  Dim msg As Outlook.MailItem
  Dim att As Outlook.Attachment
  Dim fsSaveFolder, sSavePathFS, ssender As String

  On Error GoTo crash

  fsSaveFolder = "C:\Documents and Settings\user\Desktop\"
  isAttachment = False
  Set olFolder = Outlook.GetNamespace("MAPI").Folders("...email server...")
  Set olFolder = olFolder.Folders("Inbox")
  If olFolder Is Nothing Then Exit Sub

  For Each msg In olFolder.Items
    If UCase(msg.Subject) = "TEST EMAIL WITH ATTACHMENT" Then
                    If msg.Attachments.Count > 0 Then
          While msg.Attachments.Count > 0
                sSavePathFS = fsSaveFolder & msg.Attachments(1).Filename
            msg.Attachments(1).SaveAsFile sSavePathFS
            msg.Attachments(1).Delete
            isAttachment = True
          Wend
          msg.Delete
        End If
    End If    
  Next

crash:
  If isAttachment = True Then Call findFiles(fsSaveFolder)
End Sub

任何幫助將非常感激。

Answer 1

下面的代碼使用此方法作為附件處理電子郵件

1. 測試附件是否是電子郵件消息（如果文件名以msg結尾）
2. 如果附件是消息，則將其保存為"C:\\temp\\KillMe.msg" 。
3. CreateItemFromTemplate用於將保存的文件作為新消息訪問（msg2）
4. 然后代碼處理此臨時消息以將attachmnets剝離到fsSaveFolder
5. 如果附件不是消息，則根據您當前的代碼提取它

請注意，因為我沒有你的olFolder結構，Windoes版本， Outlook變量等我必須添加我自己的文件路徑和Outlook文件夾進行測試。 您需要更改這些

   Sub SaveOlAttachments()

    Dim olFolder As Outlook.MAPIFolder
    Dim msg As Outlook.MailItem
    Dim msg2 As Outlook.MailItem
    Dim att As Outlook.Attachment
    Dim strFilePath As String
    Dim strTmpMsg As String
    Dim fsSaveFolder As String

    fsSaveFolder = "C:\test\"

    'path for creating attachment msg file for stripping
    strFilePath = "C:\temp\"
    strTmpMsg = "KillMe.msg"

   'My testing done in Outlok using a "temp" folder underneath Inbox
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set olFolder = olFolder.Folders("Temp")
    If olFolder Is Nothing Then Exit Sub

    For Each msg In olFolder.Items
        If msg.Attachments.Count > 0 Then
        While msg.Attachments.Count > 0
        bflag = False
            If Right$(msg.Attachments(1).FileName, 3) = "msg" Then
                bflag = True
                msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
                Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
            End If
            If bflag Then
                sSavePathFS = fsSaveFolder & msg2.Attachments(1).FileName
                msg2.Attachments(1).SaveAsFile sSavePathFS
                msg2.Delete
            Else
                sSavePathFS = fsSaveFolder & msg.Attachments(1).FileName
                msg.Attachments(1).SaveAsFile sSavePathFS
            End If
            msg.Attachments(1).Delete
            Wend
             msg.Delete
        End If
    Next
    End Sub