Question

我需要Excel VBA代码方面的帮助。我正在尝试使用Excel文件中的VBA在Outlook电子邮件中打开Excel电子表格附件。如何在Excel vba中执行以下步骤：

打开Outlook，转到“收件箱”子文件夹“测试报告”。
在今天的日期或最近的未读电子邮件中搜索特定的主题和发件人。
打开附件或将数据复制到附件excel文件中。
激活已经打开的excel工作簿。该工作簿的名称是“ Fed 10”。
将附件数据复制到工作簿“ Fed 10”工作表“ Analysis”中。
关闭附件并将电子邮件标记为已读。

我使用了其中一篇文章中提到的代码，但是它不能按我的意愿工作。

我有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

有关更多信息，您可以参考以下链接：

Code to download attachment from Outlook, save it on desktop and open it

最后，将未读电子邮件更改为已读。

o011tm.UnRead = False

打开Outlook电子邮件中收到的打开的附件Excel文件

1 个答案: