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

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

打开outlook，转到“收件箱”子文件夹“测试报告”

在未读电子邮件中搜索当前日期或最近日期的特定主题和发件人

打开附件或复制附件excel文件中的数据

激活已打开的excel工作簿。工作簿的名称为“Fed 10”

复制工作簿“Fed 10”表“分析”中的附件数据

关闭附件并将电子邮件标记为已读

我使用了其中一篇文章中提到的代码，但它没有按照我想要的那样工作

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

Const olFolderinbox作为整数=6
'-->附件的路径
Const AttachmentPath为String=“C:\Test\”
Sub-ExtractAttachmentFromEmail（）
尺寸o01Ap为对象，乌龙为对象，o011nb为对象
作为对象的尺寸o011tm
'-->电子邮件的Outlook变量
Dim eSender作为字符串，dtRecvd作为字符串，dtSent作为字符串
Dim sSubj作为字符串，sMsg作为字符串
'-->获取Outlook实例
设置oOlAp=GetObject（，“Outlook.application”）
设置oOlns=oOlAp.GetNamespace（“MAPI”）
设置o011nb=ools.GetDefaultFolder（olFolderinbox）
'-->检查是否有任何实际未读的电子邮件
如果oOlInb.Items.Restrict（“[UnRead]=True”）.Count=0，则
MsgBox“收件箱中无未读电子邮件”
出口接头
如果结束
'-->将相关信息存储在变量中
对于oOlInb.Items.Restrict中的每一个o011tm（“[未读]=真”）
eSender=oOlItm.SenderEmailAddress
dtRecvd=oOlItm.ReceivedTime
dtSent=o011tm.CreationTime
sSubj=oOlItm.Subject
sMsg=oOlItm.Body
退出
下一个
'-->附件的新文件名
将NewFileName设置为字符串
NewFileName=附件路径和格式（日期，“DD-MM-YYYY”）和“-”
'-->从第一封未读电子邮件中提取附件
对于oOlInb.Items.Restrict中的每一个o011tm（“[未读]=真”）
'-->检查电子邮件是否确实有附件
如果oOlItm.Attachments.Count为0，则
对于o011tm.附件中的每个oOlAtch
'-->下载附件
o0lAtch.SaveAsFile新文件名&o0lAtch.Filename
退出
下一个
其他的
MsgBox“第一项没有附件”
如果结束
退出
端接头

首先，您可以在收件箱中收到所有未读的电子邮件（根据您粘贴的代码）

其次，您可以下载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

---

在代码模块顶部添加

Option Explicit

，并修复未声明的变量请参见我根据您提到的帖子编写了一个代码，但我的要求略有不同，这就是我无法理解代码的原因。

o011tm.UnRead = False