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

Download attachment from Outlook and Open in Excel

提问by Paolo Bernasconi

I'm trying to download and then open an Excel spreadsheet attachment in an Outlook email using VBA in Excel. How can I:

我正在尝试使用 Excel 中的 VBA 下载并打开 Outlook 电子邮件中的 Excel 电子表格附件。我怎样才能：

1. Downloadthe one and only attachment from the first email (the newest email) in my Outlook inbox
2. Savethe attachment in a file with a specified path (eg: "C:...")
3. Rename the attachment name with the: current date+ previous file name
4. Save the email into a different folder with a path like "C:..."
5. Mark the email in Outlook as "read"
6. Openthe excel attachment in Excel

1. 从我的 Outlook 收件箱中的第一封电子邮件（最新的电子邮件）下载唯一的附件
2. 将附件保存在指定路径的文件中（例如：“C:...”）
3. 将附件名称重命名为：当前日期+上一个文件名
4. 将电子邮件保存到不同的文件夹中，路径类似于“C:...”
5. 将 Outlook 中的电子邮件标记为“已读”
6. 在Excel中打开excel附件

I also want to be able to save the following as individual strings assigned to individual variables:

我还希望能够将以下内容保存为分配给各个变量的各个字符串：

• Sender email Address
• Date received
• Date Sent
• Subject
• The message of the email

• 发件人电子邮件地址
• 接收日期
• 发送日期
• 主题
• 电子邮件的消息

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:\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

回答by Siddharth Rout

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 :)

我可以一次性给你完整的代码，但这不会帮助你从中学习;) 所以让我们分解你的请求，然后我们将一一处理它们。这将是一篇很长的文章，所以请耐心等待： )

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.

总共有 5 个部分，将涵盖所有 7 个（是 7 个而不是 6 个）点，因此您不必为第 7 点创建新问题。

---

---

PART - 1

第1部分

1. Creating a Connection to Outlook
2. Checking if there is any unread email
3. Retrieving details like Sender email Address, Date received, Date Sent, Subject, The message of the email

1. 创建与 Outlook 的连接
2. 检查是否有未读邮件
3. 检索详细信息，如Sender email Address, Date received, Date Sent, Subject,The message of the email

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.

请参阅此代码示例。我从 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

So that take care of your request which talks about storing details in the variables.

因此，请处理您关于在变量中存储详细信息的请求。

---

---

PART - 2

第2部分

Now moving on to your next request

现在继续您的下一个请求

1. Download the one and only attachment from the first email (the newest email) in my Outlook inbox
2. Save the attachment in a file with a specified path (eg: "C:...")
3. Rename the attachment name with the: current date + previous file name

1. 从我的 Outlook 收件箱中的第一封电子邮件（最新的电子邮件）下载唯一的附件
2. 将附件保存在指定路径的文件中（例如：“C:...”）
3. 将附件名称重命名为：当前日期 + 上一个文件名

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.

请参阅此代码示例。我再次从 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

---

---

PART - 3

第 3 部分

Moving on to your next request

继续您的下一个请求

1. Save the email into a different folder with a path like "C:..."

1. 将电子邮件保存到不同的文件夹中，路径类似于“C:...”

See this code example. This save the email to say 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

第 4 部分

Moving on to your next request

继续您的下一个请求

1. Mark the email in Outlook as "read"

1. 将 Outlook 中的电子邮件标记为“已读”

See this code example. This will mark the email as read.

请参阅此代码示例。这会将电子邮件标记为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

第 - 5 部分

Moving on to your next request

继续您的下一个请求

1. Open the excel attachment in excel

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

I converted this post into several blog posts (with more explanation) which can be accessed via points 15,16 and 17 in vba-excel

我将这篇文章转换成几篇博客文章（有更多解释），可以通过vba-excel 中的第 15,16 和 17 点访问

回答by Sathish Kothandam

(Excel vba)

Thanks to Sid :) for your code(stolen your code) .. i had this situation today .Here is my code .below code saves attachement,mail also mail information ..All credits goes to Sid

感谢 Sid :) 提供您的代码（偷了您的代码）.. 我今天遇到了这种情况。这是我的代码。下面的代码保存附件，邮件也邮件信息..所有学分都归 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