使用 Excel VBA 将 Outlook 附件保存到 PC 上的文件夹

Question

我正在尝试使用 Excel VBA 将 Outlook 子文件夹中的附件保存到 C 驱动器上的文件夹中。

例如，在我的收件箱文件夹中，我有一个名为“数据”的子文件夹，在此文件夹中，有电子邮件带有不同数据的不同 excel 附件，但格式和附件名称相同，但日期已更新（例如：“附件名称 + 3 月 28 日”）。

这些电子邮件每天发送。 我想将所有尚未保存的附件保存到我的 C 驱动器上的文件夹中，然后打开每个附件以将相关数据提取到 Excel。

一旦文件在我的 C 驱动器中，我就能够提取相关数据，但我无法在没有 Outlook VBA 的情况下设置从 Excel 到 Outlook 的路径（我不想这样做）。

这就是我到目前为止所拥有的：（评论是为了我的利益，因为我是新手）

Sub attachmentsave()

Dim olook As Outlook.Application
Dim omailitem As Outlook.mailitem
'whenever dealing with folders we need to define outlook.namespace This is a class that opens the gate for me to access all outlook folders
Dim onamespace As Outlook.Namespace

Dim fol As Outlook.Folder 'we need to tell vba where we have out emails with attachments stored
Dim atmt As Outlook.Attachment '.attachment is a class that will help us deal with emails that have attachments

Set olook = New Outlook.Application
Set omailitem = olook.CreateItem(olmailitem)

'messaging application protocol interface
Set onamespace = olook.GetNameSpace("MAPI")
Set fol = onamespace.GetDefaultFolder(olFolderInbox)

For Each omailitem In fol.items
    For Each atmt In omailitem.attachments

        atmt.SaveAsFile "C:/" & atmt.FileName
        'all attachments in inbox should be save in C drive

    Next

Next

End Sub

Answer 1

您需要一个启用宏的 Excel 工作簿，其中包含对“Microsoft 输出 nn.n 对象库”的引用，其中“nn.n”取决于您运行的 Office 版本。 请不要混用版本； 我从未尝试过，但我知道它会导致问题。

我假设您熟悉 Excel VBA 并知道如何创建启用宏的工作簿。 根据您的评论，我假设您不了解参考资料。

VBA 的大部分功能都不是本机的，而是来自库，如果您需要它们的功能，您可以参考这些库。 打开 VBA 编辑器并单击工具，然后单击引用。 您将获得一长串可用参考资料。 那些在顶部的将被打勾。 例如，“Microsoft Excel nn.n 对象库”将被打勾。 如果没有此引用，编译器将不知道范围或工作表是什么。 注意：“nn.n”取决于您使用的 Office 版本。 对我来说，该值为“16.0”，因为我使用的是 Office 365。

未勾选的参考文献按字母顺序排列。 向下滚动列表，直到找到“Microsoft Outlook nn.n 对象库”。 单击左侧的框以勾选此参考。 单击“确定”。 如果您再次单击工具，然后单击引用，您将看到“Microsoft Outlook nn.n 对象库”被勾选并靠近顶部。 编译器现在可以访问 MailItem、Folder 和 Outlook 对象模型的其余部分的定义。

将下面的代码复制到一个新模块中：

Option Explicit
Sub ListStores()

  ' Needs reference to "Microsoft Output nn.n Object Library"
  ' where "nn.n" depends on the version of Outlook you are using.

  Dim AppOut As New Outlook.Application
  Dim InxStoreCrnt As Long
  Dim FldrInbox As Outlook.Folder

  With AppOut
    With .Session
      Debug.Print "List of stores:"
      For InxStoreCrnt = 1 To .Folders.Count
        Debug.Print "  " & .Folders(InxStoreCrnt).Name
      Next

      Set FldrInbox = .GetDefaultFolder(olFolderInbox)
      Debug.Print "Store for default Inbox: " & FldrInbox.Parent.Name

    End With
  End With

  AppOut.Quit
  Set AppOut = Nothing

End Sub

VBA 通常有不止一种方法可以达到预期效果。 您在代码中使用了“NameSpace”，而我使用了“Session”。 文档说这两种方法是等效的。 如果您编写自己的代码，则可以选择您喜欢的任何方法。 但是如果你去寻找有用的片段，你必须为其他有不同偏好的人做好准备。

Dim AppOut As New Outlook.Application创建一个 Outlook 实例，它将代表宏访问 Outlook 的文件。

With AppOut
  With .Session
     :   :   :   :
  End With
End With

我可以用任何 Outlook VBA 替换: : : : 。 如果 Excel 宏尝试访问电子邮件，则会警告用户并要求用户授予运行宏的权限。

Outlook 将电子邮件、约会、任务等保存在它称为 Stores 的文件中。 您可能会看到这些称为 PST 的文件，因为大多数文件都有 PST 的扩展名，但 OST 文件也是一个存储库。 您可能会看到它们称为帐户，因为默认情况下，Outlook 为每个电子邮件帐户创建一个商店。 但是，您可以根据需要创建任意数量的额外商店，其中没有一个是帐户。

此代码将创建您可以访问的商店列表：

  Debug.Print "List of stores:"
  For InxStoreCrnt = 1 To .Folders.Count
    Debug.Print "  " & .Folders(InxStoreCrnt).Name
  Next

输出可能类似于：

List of stores:
  Outlook Data File
  Smith John@ISPOne.com
  Archive Folders
  Backup
  John Smith@ISPTwo.com
  OutlookOutlook

以上是基于我家安装的。 工作装置可能会有所不同。 差异将取决于安装期间选择的选项。 工作安装也可能包含我的系统上没有的共享文件夹。

如果您查看文件夹窗格，您的名称下方会缩进其他名称。 名称将是商店，并将与宏列出的商店相匹配，尽管顺序可能不同。 文件夹窗格中的其他名称将是每个商店中的文件夹。

我的宏的最后一点是：

  Set FldrInbox = .GetDefaultFolder(olFolderInbox)
  Debug.Print "Store for default Inbox: " & FldrInbox.Parent.Name

您有类似的代码来访问收件箱，但这可能不是您想要的收件箱。 在我的系统上，此代码输出：

Store for default Inbox: Outlook Data File

“Outlook 数据文件”是 Outlook 的默认存储。 在我的系统上，日历和我的任务都保存在这家商店中，但我的电子邮件却没有。 我有两个电子邮件帐户，每个帐户都有自己的商店。

试试这个上面的宏。 GetDefaultFolder是否找到您需要访问的收件箱？

现在添加这个宏：

Sub ListStoresAndFirstEmails()

  ' Needs reference to "Microsoft Output nn.n Object Library"
  ' where "nn.n" depends on the version of Outlook you are using.

  Dim AppOut As New Outlook.Application
  Dim InxFldrCrnt As Long
  Dim InxStoreCrnt As Long
  Dim FldrInbox As Outlook.Folder

  With AppOut
    With .Session
      Debug.Print "List of stores and first emails:"
      For InxStoreCrnt = 1 To .Folders.Count
        Debug.Print "  " & .Folders(InxStoreCrnt).Name
        For InxFldrCrnt = 1 To .Folders(InxStoreCrnt).Folders.Count
          If .Folders(InxStoreCrnt).Folders(InxFldrCrnt).Name = "Inbox" Then
            Set FldrInbox = .Folders(InxStoreCrnt).Folders(InxFldrCrnt)
            If FldrInbox.Items.Count > 0 Then
              With FldrInbox.Items(1)
                Debug.Print "    Subject: " & .Subject
                Debug.Print "    Received: " & .ReceivedTime
                Debug.Print "    From: " & .SenderEmailAddress
              End With
            End If
            Exit For
          End If
        Next
      Next
    End With
  End With

  AppOut.Quit
  Set AppOut = Nothing
End Sub

这个宏也是关于调查你的商店。 宏会扫描您的商店。 对于每个商店，它会向下扫描 1 级文件夹列表以查找“收件箱”。 如果找到“收件箱”，则假定其中最旧的项目是 MailItem 并输出其主题、接收时间和发件人。 如果最旧的项目不是 MailItem，您将收到错误消息。 我几乎希望你能得到一个错误来证明不做假设的重要性。

最后补充：

Sub ListAttachments()

  Dim AppOut As New Outlook.Application
  Dim InxAttachCrnt As Long
  Dim InxItemCrnt As Long
  Dim InxStoreCrnt As Long
  Dim FldrData As Outlook.Folder

  With AppOut
    With .Session
      Set FldrData = .Folders("Outlook Data File").Folders("Inbox").Folders("Data")
    End With
  End With

  Debug.Print "List emails with attachments within: ";
  Debug.Print " " & FldrData.Name & " of " & FldrData.Parent.Name & _
              " of " & FldrData.Parent.Parent.Name
  With FldrData
    For InxItemCrnt = 1 To FldrData.Items.Count
      If .Items(InxItemCrnt).Class = olMail Then
        With .Items(InxItemCrnt)
          If .Attachments.Count > 0 Then
            Debug.Print "    Subject: " & .Subject
            Debug.Print "    Received: " & .ReceivedTime
            Debug.Print "    From: " & .SenderEmailAddress
            For InxAttachCrnt = 1 To .Attachments.Count
              Debug.Print "      " & InxAttachCrnt & " " & .Attachments(InxAttachCrnt).DisplayName
            Next
          End If
        End With
      End If
    Next
  End With

  AppOut.Quit
  Set AppOut = Nothing

End Sub

我总是在存储“Outlook 数据文件”中保留一些垃圾邮件以进行测试。

在Set FldrData = .Folders("Outlook Data File").Folders("Inbox").Folders("Data")您需要将“Outlook Data File”替换为包含感兴趣的电子邮件的商店名称。 如果我理解正确，电子邮件位于“收件箱”文件夹下的“数据”文件夹中。 如果我误解了，请注意我是如何使用“文件夹（xxxx）”链来访问所需文件夹的。 在早期的电子邮件中，我使用索引来访问商店和文件夹。 这里我指定了一个特定的文件夹。

在该文件夹中，我查找 MailItems（显示如何避免其他项目），如果它们有附件，则列出电子邮件的一些属性及其附件的名称。

这是我所能做的，因为我不完全理解您对附件的命名方式或附件保存位置的解释。