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 Output 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 Data File”。如果我理解正确，则电子邮件位于文件夹“收件箱”下的“数据”文件夹中。如果我有误解，请注意我是如何使用“文件夹（xxxx）”链来访问所需文件夹的。在较早的电子邮件中，我使用索引来访问存储和文件夹。在这里，我指定了一个特定的文件夹。

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

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

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

1 个答案: