打開Outlook電子郵件中收到的附件Excel文件

Question

我需要Excel VBA代碼方面的幫助。我正在嘗試使用Excel文件中的VBA在Outlook電子郵件中打開Excel電子表格附件。 如何在Excel vba中執行以下步驟：

1. 打開Outlook，轉到“收件箱”子文件夾“測試報告”。
2. 在今天的日期或最近的未讀電子郵件中搜索特定的主題和發件人。
3. 打開附件或將數據復制到附件excel文件中。
4. 激活已經打開的excel工作簿。 該工作簿的名稱為“ Fed 10”。
5. 將附件數據復制到工作簿“ Fed 10”工作表“ Analysis”中。
6. 關閉附件並將電子郵件標記為已讀。

我使用了其中一篇文章中提到的代碼，但是它並沒有按照我的要求工作。

我有excel 2010，如果有人可以幫助我，我也會非常感激，如果您一步一步地描述代碼，那將是非常棒的。

提前致謝

提及的代碼如下：

Const olFolderinbox As Integer = 6
'--> Path for the attachment
Const AttachmentPath As String = "C:\Test\"

Sub ExtractAttachmentFromEmail()
    Dim o01Ap As Object, oOlns As Object, o011nb As Object
    Dim o011tm 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 o011nb = 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 o011tm In oOlInb.Items.Restrict("[UnRead] = True")
        eSender = oOlItm.SenderEmailAddress
        dtRecvd = oOlItm.ReceivedTime
        dtSent = o011tm.CreationTime
        sSubj = oOlItm.Subject
        sMsg = oOlItm.Body
        Exit For
    Next

'--> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"

'--> Extract the attachment from the 1st unread email
    For Each o011tm In oOlInb.Items.Restrict("[UnRead] = True")

    '--> Check if the email actually has an attachment
    If oOlItm.Attachments.Count <> 0 Then
    For Each oOlAtch In o011tm.Attachments

    '--> Download the attachment
    o0lAtch.SaveAsFile NewFileName & o0lAtch.Filename
         Exit For
        Next
    Else
        MsgBox "The First item doesn;t have an attachment"
    End If
    Exit For

End Sub

Answer 1

首先，您可以在收件箱中收到所有未讀的電子郵件（根據您粘貼的代碼）

其次，您可以下載excel並打開它。

您可以參考以下代碼：

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat, FilePath As String

    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    saveFolder = "c:\Users\abc1\Desktop" '<<EDIT removed trailing \
    For Each objAtt In itm.Attachments
      FilePath = saveFolder & "\" & dateFormat & _
                  " " & objAtt.DisplayName
      objAtt.SaveAsFile FilePath
      runit FilePath
    Next

End Sub

Sub runit(FilePath as String)
   Dim Shex As Object
   Set Shex = CreateObject("Shell.Application")
   Shex.Open (FilePath)
End Sub

'Edit: I used this to test the code, since I'm not running
'      it from a rule
Sub Tester()

    Dim Msg As MailItem

    Set Msg = Application.ActiveInspector.CurrentItem

    saveAttachtoDisk Msg

End Sub

有關更多信息，您可以參考以下鏈接：

用於從Outlook下載附件，將其保存在桌面上並打開它的代碼

最后，將未讀電子郵件更改為已讀。

o011tm.UnRead = False