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

Answer 2

我有一个VBS脚本，可用来从保存在文件夹中的味精文件中提取所有XLS *附件。该脚本将附件保存在msg文件的同一文件夹中。我相信可以为您提供帮助。

Macro.vbs

'Variables
Dim ol, fso, folderPath, destPath, f, msg, i
'Loading objects
Set ol  = CreateObject("Outlook.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
'Setting MSG files path
folderPath = fso.GetParentFolderName(WScript.ScriptFullName)
'Setting destination path
destPath = folderPath   '* I am using the same 
WScript.Echo "==> "& folderPath
'Looping for files
For Each f In fso.GetFolder(folderPath).Files
    'Filtering only MSG files
    If LCase(fso.GetExtensionName(f)) = "msg" Then
        'Opening the file
        Set msg = ol.CreateItemFromTemplate(f.Path)
        'Checking if there are attachments
        If msg.Attachments.Count > 0 Then
            'Looping for attachments
            For i = 1 To msg.Attachments.Count
                'Checking if is a Excel file
                If LCase(Mid(msg.Attachments(i).FileName, InStrRev(msg.Attachments(i).FileName, ".") + 1 , 3)) = "xls" Then
                    WScript.Echo f.Name &" -> "& msg.Attachments(i).FileName
                    'Saving the attachment
                    msg.Attachments(i).SaveAsFile destPath &"\"& msg.Attachments(i).FileName
                End If
            Next
        End If
    End If
Next
MsgBox "Anexos extraidos com sucesso!"

要执行，请在命令提示符下使用“ cscript c：\ temp \ msg_files \ Macro.vbs”。

Answer 3

使用Namespace.OpenSharedItem。不要使用CreateItemFromTemplate - 它会清除许多属性（例如发送者和接收者相关的属性）。

Answer 4

我更改了此代码，以便您可以从Excel而非Outlook中提取附件。

别忘了引用Outlook库，否则您将收到错误消息

deleted_at

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

4 个答案: