VBA代码，用于将另一封电子邮件中的Outlook电子邮件中的附件(Excel文件)保存为附件

问题描述：

我有用于将附件保存在特定Outlook文件夹中的邮件中的代码.

I have code that saves attachments in message in a specific Outlook folder.

如果电子邮件带有附件，我的脚本将起作用，但是如果电子邮件作为附件带有附件发送，则我的脚本将不起作用.

My script will work if the email has an attachment, but will not work if the email was sent as an attachment with an attachment.

在这种情况下，我的电子邮件包含其他电子邮件作为附件(来自自动转发规则).然后，嵌入式电子邮件附件将包含excel文件.

In this case my emails contains other emails as attachments (from an auto-forward rule). The embedded email attachments then contain excel files.

请在下面查看我当前的 vba :

Please see my current vba below:

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

任何帮助将不胜感激.

Any help would be much appreciated.

答

下面的代码使用这种方法将电子邮件作为附件工作

The code below uses this approach to work on the email as an attachment

测试附件是否为电子邮件(如果文件名以msg结尾)
如果附件是邮件，则另存为"C:\temp\KillMe.msg".
CreateItemFromTemplate用于作为新消息(msg2)访问保存的文件
然后代码处理此临时消息以将Attachmnets剥离到fsSaveFolder
如果附件不是邮件，则会按照您当前的代码将其提取

Tests whether the attachment is an email message or not (if the filename ends in msg)
If the attachment is a message, it is saved as "C:\temp\KillMe.msg".
CreateItemFromTemplate is used to access the saved file as a new message (msg2)
The code then processes this temporary message to strip the attachmnets to fsSaveFolder
If the attachment is not a message then it is extracted as per your current code

请注意，由于我没有您的olFolder结构，Windoes版本，Outlook变量等，因此必须添加自己的文件路径和Outlook文件夹进行测试.您将需要更改这些

Note that as I didnt have your olFolder structure, Windoes version, Outlook variable etc I have had to add in my own file paths and Outlook folders to test. You will need to change these

   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

VBA代码，用于将另一封电子邮件中的Outlook电子邮件中的附件(Excel文件)保存为附件

相关推荐