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

Question

我正在尝试下载,然后使用Excel中的VBA在Outlook电子邮件中打开Excel电子表格附件.我怎么能够:

1. 从我的Outlook收件箱中的第一封电子邮件(最新电子邮件)下载唯一的附件
2. 将附件保存在具有指定路径的文件中(例如:"C:...")
3. 使用以下命令重命名附件名称:当前日期 + 上一个文件名
4. 将电子邮件保存到其他文件夹中,其路径如"C:..."
5. 将Outlook中的电子邮件标记为"已读"
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

我可以一次性给你完整的代码,但这对你学习不会有帮助;)所以让我们分解你的请求,然后我们将逐一解决它们.这将是一个非常长的帖子,所以请耐心等待: )

共有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. 使用以下命令重命名附件名称:当前日期+上一个文件名

请参阅此代码示例.我再次使用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. 将电子邮件保存到其他文件夹中,其路径如"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.

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