从 Outlook 下载附件并在 Excel 中打开
Posted
技术标签:
【中文标题】从 Outlook 下载附件并在 Excel 中打开【英文标题】:Download attachment from Outlook and Open in Excel 【发布时间】:2012-07-31 15:39:00 【问题描述】:我正在尝试在 Excel 中使用 VBA 下载并打开 Outlook 电子邮件中的 Excel 电子表格附件。 我该怎么做:
-
下载我的 Outlook 收件箱中第一封电子邮件(最新电子邮件)的唯一附件
将附件保存到指定路径的文件中(例如:“C:...”)
将附件名称重命名为:当前日期 + 以前的文件名
将电子邮件保存到其他文件夹,路径为“C:...”
将 Outlook 中的电子邮件标记为“已读”
在 Excel 中打开 excel 附件
我还希望能够将以下内容保存为分配给单个变量的单个字符串:
发件人电子邮件地址 收到日期 发送日期 主题 电子邮件的信息虽然这可能会更好地在单独的问题中提出/自己寻找。
我目前拥有的代码来自其他在线论坛,可能不是很有帮助。然而,这里有一些我一直在努力的点点滴滴:
Sub SaveAttachments()
Dim olFolder As Outlook.MAPIFolder
Dim att As Outlook.Attachment
Dim strFilePath As String
Dim fsSaveFolder As String
fsSaveFolder = "C:\test\"
strFilePath = "C:\temp\"
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】:我可以一次性为您提供完整的代码,但这无助于您从中学习 ;) 所以让我们分解您的请求,然后我们将一个一个地处理它们。这将是一篇很长的帖子,所以耐心点:)
共有 5 个部分将涵盖所有 7 个(是 7 个而不是 6 个)点,因此您不必为第 7 个点创建新问题。
部分 - 1
-
创建与 Outlook 的连接
检查是否有未读邮件
检索详细信息,如
Sender email Address
、Date received
、Date Sent
、Subject
、The message of the email
请参阅此代码示例。我正在从 Excel 中与 Outlook 进行后期绑定,然后检查是否有任何未读项目以及是否有我正在检索相关详细信息。
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
因此请处理您的请求,该请求涉及在变量中存储详细信息。
部分 - 2
现在继续您的下一个请求
-
从我的 Outlook 收件箱中的第一封电子邮件(最新的电子邮件)下载唯一的附件
将附件保存在指定路径的文件中(例如:“C:...”)
将附件名称重命名为:当前日期 + 以前的文件名
请参阅此代码示例。我再次从 Excel 与 Outlook 进行后期绑定,然后检查是否有任何未读项目,如果有,我将进一步检查它是否有附件,然后将其下载到相关文件夹。
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 部分
继续您的下一个请求
-
将电子邮件保存到另一个文件夹,路径为“C:...”
请参阅此代码示例。这保存电子邮件说 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
继续您的下一个请求
-
将 Outlook 中的电子邮件标记为“已读”
请参阅此代码示例。这会将电子邮件标记为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
继续您的下一个请求
-
在excel中打开excel附件
一旦您下载了如上所示的文件/附件,然后使用下面代码中的路径打开文件。
Sub OpenExcelFile()
Dim wb As Workbook
'~~> FilePath is the file that we earlier downloaded
Set wb = Workbooks.Open(FilePath)
End Sub
我将这篇文章转换成几篇博文(有更多解释),可以通过vba-excel 中的第 15,16 和 17 点访问
【讨论】:
你睡觉吗? :)。我什至没有时间读这个,更不用说写了,假设我知道怎么做。感谢您在 SO 上所做的所有出色工作。 +1 天哪!你真的拥有世界上所有的时间:D 但是我必须说我真的很喜欢阅读你的帖子。你肯定会花时间让你的帖子尽可能地提供信息。继续努力! 这篇文章太棒了!感谢您解释每个步骤并花时间写出每个步骤。我希望我能不止一次地投票给这个答案。继续在 SO 上的惊人工作。 :) Sid,很高兴看到你再次发帖!每次您回答问题时,我都会学到一些有价值的东西。 :) @Siddharth Rout 如果我想从给定主题的特定文件中读取附件怎么办。【参考方案2】:(Excel vba)
感谢 Sid :) 提供您的代码(窃取您的代码).. 我今天遇到了这种情况。这是我的代码。下面的代码保存附件,邮件也邮件信息..所有学分都归 Sid em>
Tested
Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String
Const num As Integer = 6
Const path As String = "C:\HP\"
Const emailpath As String = "C:\Dell\"
Const olFolderInbox As Integer = 6
Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)
If olmail.items.restrict("[UNREAD]=True").Count = 0 Then
MsgBox ("No Unread mails")
Else
For Each olitem In olmail.items.restrict("[UNREAD]=True")
lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lrow).Value = olitem.Subject
Range("B" & lrow).Value = olitem.senderemailaddress
Range("C" & lrow).Value = olitem.to
Range("D" & lrow).Value = olitem.cc
Range("E" & lrow).Value = olitem.body
If olitem.attachments.Count <> 0 Then
For Each olattach In olitem.attachments
olattach.SaveAsFile path & Format(Date, "MM-dd-yyyy") & olattach.Filename
Next olattach
End If
str = olitem.Subject
str = Replace(str, "/", "-")
str = Replace(str, "|", "_")
Debug.Print str
olitem.SaveAs (emailpath & str & ".msg")
olitem.unread = False
DoEvents
olitem.Save
Next olitem
End If
ActiveSheet.Rows.WrapText = False
End Sub
【讨论】:
以上是关于从 Outlook 下载附件并在 Excel 中打开的主要内容,如果未能解决你的问题,请参考以下文章
使用 Ms Graph Api 将附件文件从 Outlook 复制到 onedrive,无需下载
如何使用 Excel VBA 打开 Outlook excel 附件,在特定时间范围内发送到特定 Outlook 文件夹?