excel - 使用 VBA 从保存的 .msg 文件中提取附件

Question

我正在尝试从保存的 Outlook 邮件中提取附加的 Excel 电子表格。这些消息已作为 .msg 文件保存到共享文件夹中。

我正在努力让 VBA 将消息识别为文件。

我正在尝试在下面的代码中获取消息详细信息作为概念证明。

一旦我完成了这项工作，我就可以循环浏览文件并处理附件。

我在此网站上找到了用于从仍在 Outlook 中的电子邮件中提取附件的代码，但我无权访问 Outlook 文件夹，并且原始邮件已被删除。

Sub ExtractExcel()
Dim aExcel As Outlook.Attachment
Dim stFilePath As String
Dim stFileName As String
Dim stAttName As String
Dim stSaveFolder As String
Dim oEmail As Outlook.MailItem

'~~> Outlook Variables for email
Dim eSender As String, dtRecvd As String, dtSent As String
Dim sSubj As String, sMsg As String

stFilePath = "Y:\Purchasing\The Team\User Name\Supply Chain Admin - Outlook\New-Revised Orders\FW  Mail Order Daffodil.msg"
stSaveFolder = "C:\Projects\SOTD\PO_Excel"

Debug.Print stFilePath
Debug.Print stSaveFolder

oEmail = stFilePath

With oEmail 
    eSender = oEmail.SenderEmailAddress
    dtRecvd = oEmail.ReceivedTime
    dtSent = oEmail.CreationTime
    sSubj = oEmail.Subject
    sMsg = oEmail.Body

    Debug.Print eSender
    Debug.Print dtRecvd
    Debug.Print dtSent
    Debug.Print sSubj
    Debug.Print sMsg
End With

End Sub

我正在使用 Excel VBA，因为我很熟悉它，但很高兴收到建议的任何替代策略。

Answer 1

使用 VBA Code to save an attachment (excel file) from an Outlook email that was inside another email as an attachment 中的 CreateItemFromTemplate你可以

• 从 C:\temp\ 打开 msg 文件
• 删除 C:\temp1\ 中的所有附件

代码

Sub SaveOlAttachments()

Dim msg As Outlook.MailItem
Dim att As Outlook.Attachment
Dim strFilePath As String
Dim strAttPath As String

    'path for creating msgs
strFilePath = "C:\temp\"
    'path for saving attachments
strAttPath = "C:\temp1\"

strFile = Dir(strFilePath & "*.msg")
Do While Len(strFile) > 0
    Set msg = Application.CreateItemFromTemplate(strFilePath & strFile)
    If msg.Attachments.Count > 0 Then
         For Each att In msg.Attachments
             att.SaveAsFile strAttPath & att.FileName
         Next
    End If
    strFile = Dir
Loop

End Sub