使用VBA从已保存的.msg文件中提取附件 [英] Extract attachments from saved .msg files using VBA
问题描述
我正在尝试从已保存的Outlook邮件中提取附加的Excel电子表格.邮件已作为.msg文件保存到共享文件夹中.
I am trying to extract attached Excel spreadsheets from saved Outlook messages. The messages have been saved into a shared folder as .msg files.
我正在努力让VBA将消息识别为文件.
I am struggling to get VBA to recognise the messages as files.
我正在尝试在下面的代码中获取消息的详细信息,以作为概念证明.
I am trying to get the message details in the code below as a proof of concept.
一旦完成这项工作,我就可以遍历文件并处理附件.
Once I have this working I can work on looping through the files and dealing with the attachments.
我在此站点上找到了用于从仍在Outlook中的电子邮件中提取附件的代码,但是我无权访问Outlook文件夹,并且原始邮件已被删除.
I have found code on this site for extracting attachments from emails still in Outlook but I do not have access to the Outlook folders and the original messages have been deleted.
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,因为我很熟悉它,但很高兴提出任何替代策略.
I'm using Excel VBA as I am familiar with it but am happy to have any alternative strategies suggested.
推荐答案
使用
Using CreateItemFromTemplate
from VBA Code to save an attachment (excel file) from an Outlook email that was inside another email as an attachment you could
- 打开
C:\temp\
中的 msg 文件
- 将所有附件带到
C:\temp1\
- open msg files from
C:\temp\
- strip all attachments to
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
这篇关于使用VBA从已保存的.msg文件中提取附件的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!