Question

在Outlook中使用VBA并且在定位时遇到了水平文件夹，因为它似乎只能处理一个“水平”级别。我目前在我的Outlook中可能有一个5层文件夹组织，每天我会收到许多需要提交附件的电子邮件。到目前为止，我正在使用我的第一个文件夹来提取附件并将它们存储在我已经创建的指定文件夹中，但由于子文件夹位于第4层，因此无法正常工作。

Sub GetAttachments()
On Error GoTo GetAttachments_err
' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("DZ1")
    i = 0
' Check Inbox for messages and exit of none found
    If SubFolder.Items.Count = 0 Then
   MsgBox "There are no messages in the Sales Reports folder." _
   , vbInformation, "Nothing Found"
   Exit Sub
End If
' Check each message for attachments
    If SubFolder.Items.Count > 0 Then
    For Each Item In SubFolder.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
            FileName = "File path" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item
End If
' Clear memory
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle errors
GetAttachments_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume GetAttachments_exit
End Sub

我能帮忙吗？

干杯

Answer 1

您需要重构代码，以便在文件夹中执行的操作采用递归方法，当需要访问文件夹的Folder.Folders集合中的另一个文件夹时调用自身。

Answer 2

按照路径操作，就像手动获取文件夹一样。

设置SubFolder = Inbox.Folders（＆＃34; DZ1＆＃34;）。文件夹（＆＃34; DZ2＆＃34;）。文件夹（＆＃34; DZ3＆＃34;）。文件夹（＆＃34; DZ4＆＃34）

Answer 3

只搜索子文件夹只会检查直接子文件夹。不是＆＃34;孙子＆＃34;。

您必须执行以下操作：

Sub subfolderrs_6_levels()
   Dim Ol, Mf, Mf1, mf2, Ns, mf3, mf4, mf5, mf6, I&
   On Error Resume Next
   For Each Mf In Ns.Folders
      call_your_routine(mf)
      I = I + 1
      For Each Mf1 In Mf.Folders
          call_your_routine(mf1)
      I = I + 1
         For Each mf2 In Mf1.Folders
           call_your_routine(mf2)
      I = I + 1
            For Each mf3 In mf2.Folders
            call_your_routine(mf3)
      I = I + 1
            For Each mf4 In mf3.Folders
            call_your_routine(mf4)
      I = I + 1
            For Each mf5 In mf4.Folders
            call_your_routine(mf5)
      I = I + 1
            For Each mf6 In mf5.Folders
            call_your_routine(mf6)
            Next
            Next
            Next
            Next
         Next
      Next
   Next
   Set Ns = Nothing: Set Mf1 = Nothing: Set Mf = Nothing: Set Ol = Nothing: 
   Set mf2 = Nothing: Set mf3 = Nothing: Set mf4 = Nothing: Set mf5 = Nothing: Set mf6 = Nothing
End Sub

sub call_your_routine(mf as Outlook.folder)
    For Each Item In SubFolder.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
            FileName = "File path" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item
end sub

Answer 4

您可能会发现How to: Enumerate Folders on All Stores文章很有帮助。

保存Outlook附件

4 个答案: