用于将另一封电子邮件中的 Outlook 电子邮件中的附件(excel 文件)保存为附件的 VBA 代码 [英] VBA Code to save an attachment (excel file) from an Outlook email that was inside another email as an attachment
问题描述
我有将邮件中的附件保存在特定 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 SettingsuserDesktop"
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
任何帮助将不胜感激.
推荐答案
下面的代码使用这种方法将电子邮件作为附件处理
The code below uses this approach to work on the email as an attachment
- 测试附件是否是电子邮件消息(如果文件名以 msg 结尾)
- 如果附件是邮件,则保存为
"C: empKillMe.msg"
. CreateItemFromTemplate
用于访问保存的文件作为新消息 (msg2)- 然后代码处理这个临时消息以将附件剥离到
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: empKillMe.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: est"
'path for creating attachment msg file for stripping
strFilePath = "C: emp"
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
这篇关于用于将另一封电子邮件中的 Outlook 电子邮件中的附件(excel 文件)保存为附件的 VBA 代码的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!