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

总结： 如何调用收件箱的

子文件夹

，而不知道它们的名称？在将它们导出到.pst的环境中，这可能吗

详细说明：

我在Outlook Exchange 2010环境中工作

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

通过研究，我发现了一段代码，可以将与电子邮件帐户相关的所有项目导出到一个.pst，并且我修改了该代码，以该帐户中的特定子文件夹为目标

接下来，我希望能够针对收件箱下的一系列子文件夹。我是否能够以某种方式在它们之间循环—而不指定它们的名称？在这种情况下，这行得通吗？注意：我有一个

用户表单

，允许他们选择要从哪个帐户导出

代码：

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

---

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

---

为什么要使用Set olBackup=olNS.Folders.GetLast？该集合不保证按任何特定顺序进行。使用文件夹名称（

olNS.Folders.Item（“文件夹名称”））

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

为什么要使用Set olBackup=olNS.Folders.GetLast？该集合不保证按任何特定顺序进行。使用文件夹名称（

olNS.Folders.Item（“文件夹名称”））