将循环中的收件箱子文件夹导出到 pst

Question

总结： 如何在不知道他们叫什么的情况下拨打收件箱的subfolders？在将它们导出到 .pst 的情况下，这是否可能？

完整解释：

我在 Outlook Exchange 2010 环境中工作。

我正在尝试为大约 30 个用户将电子邮件导出为 .pst 文件。它们将从服务器上的无限存储空间变为 1.5 GB。这尤其令人遗憾，因为由于政策和法律原因，用户拥有必须保留的文件。我已采取措施减小它们的大小，但其中一些收件箱非常大。

通过研究，我发现了一段代码，可以将与电子邮件帐户关联的所有项目导出到单个 .pst，并且我已修改该代码以针对该帐户中的特定 subfolder .

接下来，我希望能够针对收件箱下的一系列 subfolders。我是否能够以某种方式遍历它们 - 无需指定它们的名称？在这种情况下会起作用吗？注意：我有一个 userform，允许他们选择要从哪个帐户导出。

代码：

Option Explicit

Sub BackUpEmailInPST()
    Dim olNS As Outlook.NameSpace
    Dim olBackup As Outlook.Folder
    Dim bFound As Boolean
    Dim strPath As String
    Dim strDisplayName As String
    strDisplayName = "Backup " & Format(Date, "yyyymmdd")
    strPath = "C:\Users\TaylorMat\Documents\Attachments\" & strDisplayName &         ".pst"
    Set olNS = GetNamespace("MAPI")
    olNS.AddStore strPath
    Set olBackup = olNS.Folders.GetLast
    olBackup.Name = strDisplayName
    RunBackup olNS, olBackup
    olNS.RemoveStore olBackup
lbl_Exit:
    Set olNS = Nothing
    Set olBackup = Nothing
    Exit Sub
End Sub

Sub RunBackup(olNS As Outlook.NameSpace, olBackup As Outlook.Folder)
    Dim oFrm As New frmSelectAccount
    Dim strAcc As String
    Dim olStore As Store
    Dim olFolder As Folder
    Dim olNewFolder As Folder
    Dim i As Long
    With oFrm
        .BackColor = RGB(191, 219, 255)
        .Height = 190
        .Width = 240
        .Caption = "Backup E-Mail"
        With .CommandButton1
            .Caption = "Next"
            .Height = 24
            .Width = 72
            .Top = 126
            .Left = 132
        End With
        With .CommandButton2
            .Caption = "Quit"
            .Height = 24
            .Width = 72
            .Top = 126
            .Left = 24
        End With

        With .ListBox1
            .Height = 72
            .Width = 180
            .Left = 24
            .Top = 42
            For Each olStore In olNS.Stores
                If Not olStore.DisplayName = olBackup Then
                    .AddItem olStore
                End If
            Next olStore
        End With
    With .Label1
        .BackColor = RGB(191, 219, 255)
        .Height = 24
        .Left = 24
        .Width = 174
        .Top = 6
        .Font.Size = 10
        .Caption = "Select e-mail store to backup"
        .TextAlign = fmTextAlignCenter
    End With
    .Show
    If .Tag = 0 Then GoTo lbl_Exit
    With oFrm.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                strAcc = .List(i)
                Exit For
            End If
        Next i
    End With
    Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderInbox)
    Set olNewFolder = olFolder.Folders("Export")
    olNewFolder.CopyTo olBackup
    DoEvents
    Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderSentMail)
    olFolder.CopyTo olBackup
End With
lbl_Exit:
    Unload oFrm
    Set olStore = Nothing
    Set olFolder = Nothing
    Exit Sub
End Sub

Answer 1

使用 MAPIFolder.Folders 集合循环遍历子文件夹。

为什么要使用 Set olBackup = olNS.Folders.GetLast？不保证该集合按任何特定顺序排列。使用文件夹名称 (olNS.Folders.Item("Folder name"))