时间戳

首页 > 解决方案 > 使用 Excel VBA 将 Outlook 附件保存到 PC 上的文件夹

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

问题描述

我正在尝试使用 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

标签： excelvbaoutlook

解决方案

您需要一个启用宏的 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 将电子邮件、约会、任务等保存在它称为“商店”的文件中。您可能会看到这些称为 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 数据文件”替换为包含感兴趣电子邮件的商店名称。如果我理解正确，这些电子邮件位于“收件箱”文件夹下的“数据”文件夹中。如果我误解了，请注意我是如何使用“文件夹（xxxx）”链到达所需文件夹的。在早期的电子邮件中，我使用索引来访问商店和文件夹。在这里，我指定了一个特定的文件夹。

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

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

推荐阅读