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

Question

我正在尝试下载Excel电子表格附件，然后使用Excel中的VBA打开Outlook电子邮件中的Excel电子表格附件。我如何才能：

1. 从我的收件箱中的第一封电子邮件(最新的电子邮件)下载
2. 将附件保存在具有指定路径的文件中(例如：“C：.”)
3. 将附件名称重命名为：当前日期+上一个文件名
4. 将电子邮件保存到另一个文件夹中，路径为“C：.”
5. 将Outlook中的电子邮件标记为"read“
6. 打开 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

Answer 1

我可以一次给您完整的代码，但这无助于您从中学习;)因此，让我们打破您的请求，然后我们将处理它们1乘1。这将是一个非常长的帖子，所以请耐心:)

一共有5个部分，将涵盖所有7点(是的7点，而不是6点)，所以你不必为你的第7点创建一个新的问题。

第1部

1. 创建与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

这样就可以处理您的请求了，它讨论了如何在变量中存储细节。

第2部

现在转到你的下一个请求

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

参见此代码示例。我再次使用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部

继续你的下一个请求

1. 将电子邮件保存到另一个文件夹中，路径为“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部分

继续你的下一个请求

1. 将Outlook中的电子邮件标记为"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

第5部

继续你的下一个请求

1. 在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点访问。

Answer 2

(Excel vba)

感谢希德:)你的代码(偷了你的代码)。我今天遇到了这种情况，.Here是我的代码.below代码节省注意力，邮件也是邮件信息..All信用给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