从Outlook下载附件并在Excel中打开

我试图下载并使用Excel中的VBA在Outlook电子邮件中打开Excel电子表格附件。 我怎么能够：

1. 从我的Outlook收件箱中的第一封电子邮件（最新电子邮件） 下载唯一的附件
2. 将附件保存在具有指定path的文件中（例如：“C：…”）
3. 使用： 当前date + 以前的文件名重命名附件名称
4. 将电子邮件保存到不同的文件夹，path如“C：…”
5. 在Outlook中将电子邮件标记为“已读”
6. 在Excel中打开 Excel的附件

我也希望能够将以下内容保存为分配给各个variables的单个string：

• 发件人电子邮件地址
• 接收date
• 发送date
• 学科
• 电子邮件的消息

虽然这可能会更好地问一个单独的问题/自己看看。

我目前所做的代码来自其他在线论坛，可能不是很有帮助。 不过，这里有一些我一直在努力的东西：

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 

Answer 1

我可以一次性给你完整的代码，但这不会帮助你从中学习）所以，让我们分解你的请求，然后我们将1加1。这将是一个很长的职位，所以要耐心等待： ）

总共有5个部分将覆盖全部7个（是7个而不是6个）点，所以你不必为你的第7点创build一个新的问题。

---

第1部分

1. 创build到Outlook的连接
2. 检查是否有未读的电子邮件
3. 检索详细信息，如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 

所以，照顾你的请求，谈到在variables中存储细节。

---

第2部分

现在转到您的下一个请求

1. 从我的Outlook收件箱中的第一封电子邮件（最新电子邮件）下载唯一的附件
2. 将附件保存在具有指定path的文件中（例如：“C：…”）
3. 使用：当前date+以前的文件名重命名附件名称

看到这个代码示例。 我再次与Outlook从Excel绑定，然后检查是否有任何未读的项目，如果有我进一步检查，如果它有一个附件，如果它已经下载到相关的文件夹。

 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部分

转到下一个请求

1. 将电子邮件保存到不同的文件夹，path如“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 

---

PART – 4

转到下一个请求

1. 在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 

---

PART – 5

转到下一个请求

1. 在excel中打开excel附件

一旦你下载了如上所示的文件/附件，然后在下面的代码中使用该path来打开文件。

 Sub OpenExcelFile() Dim wb As Workbook '~~> FilePath is the file that we earlier downloaded Set wb = Workbooks.Open(FilePath) End Sub 

Answer 2

 (Excel vba) 

谢谢你的代码（偷了你的代码）..我今天有这种情况。这里是我的代码。下面的代码保存附件，邮件也邮件信息..所有学分去Sid

 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