从 Outlook 下载附件并在 Excel 中打开 [英] Download attachment from Outlook and Open in Excel
问题描述
我正在尝试使用 Excel 中的 VBA 下载并打开 Outlook 电子邮件中的 Excel 电子表格附件.我该怎么办:
I'm trying to download and then open an Excel spreadsheet attachment in an Outlook email using VBA in Excel. How can I:
- 下载我的 Outlook 收件箱中第一封电子邮件(最新电子邮件)中的唯一附件
- 保存附件到指定路径的文件中(例如:C:...")
- 使用以下内容重命名附件名称:当前日期 + 上一个文件名
- 将电子邮件保存到其他文件夹中,路径类似于C:..."
- 将 Outlook 中的电子邮件标记为已读"
- 打开Excel附件
- Download the one and only attachment from the first email (the newest email) in my Outlook inbox
- Save the attachment in a file with a specified path (eg: "C:...")
- Rename the attachment name with the: current date + previous file name
- Save the email into a different folder with a path like "C:..."
- Mark the email in Outlook as "read"
- Open the excel attachment in Excel
我还希望能够将以下内容保存为分配给各个变量的各个字符串:
I also want to be able to save the following as individual strings assigned to individual variables:
- 发件人电子邮件地址
- 收到日期
- 发送日期
- 主题
- 邮件内容
尽管在单独的问题中提出/自己寻找可能会更好.
although this may be better to ask in a separate question / look for it myself.
我目前拥有的代码来自其他在线论坛,可能不是很有帮助.但是,这里有一些我一直在研究的点点滴滴:
The code I do have currently is from other forums online, and probably isn't very helpful. However, here are some bits and pieces I have been working on:
Sub SaveAttachments()
Dim olFolder As Outlook.MAPIFolder
Dim att As Outlook.Attachment
Dim strFilePath As String
Dim fsSaveFolder As String
fsSaveFolder = "C: est"
strFilePath = "C: emp"
Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each msg In olFolder.Items
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
sSavePathFS = fsSaveFolder & msg2.Attachments(1).Filename
End If
End Sub
推荐答案
我可以一次性给你完整的代码,但这不会帮助你从中学习 ;) 所以让我们打破你的要求,然后我们来解决他们 1 对 1.这将是一个很长的帖子,所以请耐心等待 :)
I can give you the complete code in one go but that wouldn't help you learn from it ;) So let's Break up your requests and then we will tackle them 1 by 1. This is gonna be a very long post so be patient :)
共有 5 个部分,涵盖所有 7 点(是 7 点而不是 6 点),因此您无需为第 7 点创建新问题.
There are total 5 parts which will cover all 7 (yes 7 and not 6) points so you don't have to create a new question for your 7th point.
- 创建与 Outlook 的连接
- 检查是否有未读邮件
- 检索诸如
发件人电子邮件地址
、Date received
、Date Sent
、Subject
、The邮件内容
请参阅此代码示例.我正在从 Excel 使用 Outlook 进行后期绑定,然后检查是否有任何未读项目,如果有,我正在检索相关详细信息.
See this code example. I am latebinding with Outlook from Excel then checking if there are any unread items and if there are I am retrieving the relevant details.
Const olFolderInbox As Integer = 6
Sub ExtractFirstUnreadEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object
'~~> Outlook Variables for email
Dim eSender As String, dtRecvd As String, dtSent As String
Dim sSubj As String, sMsg As String
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
eSender = oOlItm.SenderEmailAddress
dtRecvd = oOlItm.ReceivedTime
dtSent = oOlItm.CreationTime
sSubj = oOlItm.Subject
sMsg = oOlItm.Body
Exit For
Next
Debug.Print eSender
Debug.Print dtRecvd
Debug.Print dtSent
Debug.Print sSubj
Debug.Print sMsg
End Sub
这样就可以处理您关于在变量中存储详细信息的请求.
So that take care of your request which talks about storing details in the variables.
现在继续您的下一个请求
Now moving on to your next request
- 从我的 Outlook 收件箱中的第一封电子邮件(最新的电子邮件)下载一个也是唯一的附件
- 将附件保存在指定路径的文件中(例如:C:...")
- 将附件名称重命名为:当前日期 + 上一个文件名
请参阅此代码示例.我再次从 Excel 使用 Outlook 进行后期绑定,然后检查是否有任何未读项目,如果有,我将进一步检查它是否有附件,然后将其下载到相关文件夹.
See this code example. I am again latebinding with Outlook from Excel then checking if there are any unread items and if there are I am further checking if it has an attachment and if it has then download it to the relevant folder.
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:"
Sub DownloadAttachmentFirstUnreadEmail()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
'~~> Check if the email actually has an attachment
If oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
'~~> Download the attachment
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Exit For
Next
Else
MsgBox "The First item doesn't have an attachment"
End If
Exit For
Next
End Sub
<小时>
部分 - 3
继续处理您的下一个请求
PART - 3
Moving on to your next request
- 将电子邮件保存到其他文件夹中,路径类似于C:..."
请参阅此代码示例.这将电子邮件保存为 C:
See this code example. This save the email to say C:
Const olFolderInbox As Integer = 6
'~~> Path + Filename of the email for saving
Const sEmail As String = "C:ExportedEmail.msg"
Sub SaveFirstUnreadEmail()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Save the 1st unread email
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
oOlItm.SaveAs sEmail, 3
Exit For
Next
End Sub
<小时>
部分 - 4
继续处理您的下一个请求
PART - 4
Moving on to your next request
- 将 Outlook 中的电子邮件标记为已读"
请参阅此代码示例.这会将电子邮件标记为 read
.
See this code example. This will mark the email as read
.
Const olFolderInbox As Integer = 6
Sub MarkAsUnread()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlAtch As Object
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Mark 1st unread email as read
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
oOlItm.UnRead = False
DoEvents
oOlItm.Save
Exit For
Next
End Sub
<小时>
部分 - 5
继续处理您的下一个请求
PART - 5
Moving on to your next request
- 在excel中打开excel附件
如上所示下载文件/附件后,请在以下代码中使用该路径打开文件.
once you have downloaded the file/attachment as shown above then use that path in the below code to open the file.
Sub OpenExcelFile()
Dim wb As Workbook
'~~> FilePath is the file that we earlier downloaded
Set wb = Workbooks.Open(FilePath)
End Sub
我将这篇文章转换成几篇博客文章(有更多解释),可以通过 vba-excel
I converted this post into several blog posts (with more explanation) which can be accessed via points 15,16 and 17 in vba-excel
这篇关于从 Outlook 下载附件并在 Excel 中打开的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!