如何在Outlook中导出和打印所有文件夹和子文件夹的列表？

一般来说，您可以按 按Ctrl + 6 键以查看Outlook导航窗格上所有文件夹的列表。但是，您无法打印文件夹列表。本文将介绍两个VBA脚本，以导出和打印Outlook中所有文件夹及其子文件夹的列表。

在新电子邮件中导出并打印所有Outlook文件夹及其子文件夹的列表
在记事本中导出并打印所有Outlook文件夹及其子文件夹中的列表

在新电子邮件中导出并打印所有Outlook文件夹及其子文件夹的列表

此方法将引入VBA，以将指定电子邮件帐户中的所有文件夹及其子文件夹的列表导出到Outlook中的新电子邮件中，然后您可以轻松地打印文件夹列表。

1。按其他 + F11 键以打开“ Microsoft Visual Basic应用程序”窗口。

2。点击插页 > 模块，然后将以下VBA代码粘贴到新的“模块”窗口中。

VBA：在Outlook中的新电子邮件中导出文件夹和子文件夹的列表

Public gFolders As String

Public Sub GetFolderNames()
Dim oSession As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
Dim oNewMail As Outlook.mailItem

Set oSession = Outlook.Application.GetNamespace("MAPI")
Set oFolder = oSession.PickFolder

If (oFolder Is Nothing) Then Exit Sub

ProcessFolder oFolder

Set oNewMail = Application.CreateItem(olMailItem)
oNewMail.Body = gFolders
oNewMail.Display

gFolders = ""
End Sub

Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)

Dim i As Long
Dim oSubFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.MAPIFolder
Dim sFolderPaths As String

    For i = CurrentFolder.Folders.Count To 1 Step -1
Set oFolder = CurrentFolder.Folders(i)

sFolderPaths = oFolder.FolderPath
gFolders = gFolders & vbCrLf & sFolderPaths & " " & oFolder.Items.Count
Next

For Each oSubFolder In CurrentFolder.Folders
If oSubFolder.Name <> "Deleted Items" Then
ProcessFolder oSubFolder
End If

Next

End Sub

3。按 F5 运行此VBA的关键。

4.在弹出的选择文件夹对话框中，选择要打印其文件夹列表的电子邮件帐户，然后单击 OK 按钮。看截图：

5.现在，指定的电子邮件帐户的文件夹列表已复制到新的电子邮件，如下图所示。请点击文件 > 打印打印文件夹的复制列表。

6.打印后，请关闭新的电子邮件而不保存。

在记事本中导出并打印所有Outlook文件夹及其子文件夹中的列表

此方法将引入VBA，以将指定电子邮件帐户中的所有文件夹及其子文件夹的列表从Outlook导出到记事本，然后您可以轻松地在记事本中打印Outlook文件夹的列表。

1。按其他 + F11 键以打开“ Microsoft Visual Basic应用程序”窗口。

2。点击插页 > 模块，然后将以下VBA代码粘贴到新的“模块”窗口中。

VBA：将所有Outlook文件夹和子文件夹的列表从Outlook导出到记事本

Dim gFileName, gCreateTree, gBase

Public Sub ExportFolderTree()
Dim objOutlook
Dim F, Folders
Dim Result

  Set objOutlook = CreateObject("Outlook.Application")

  Set F = objOutlook.Session.PickFolder

If Not F Is Nothing Then
Set Folders = F.Folders

    Result = MsgBox("Do you want to create tree?", vbYesNo + vbDefaultButton2 + vbApplicationModal, "Output Folder Tree")
If Result = 6 Then
gCreateTree = True
Else
gCreateTree = False
End If

    gFileName = GetDesktopFolder() & "\Outlook-Folders.txt"
gBase = Len(F.FolderPath) - Len(Replace(F.FolderPath, "\", "")) + 1

    WriteToATextFile (CreateFolderTree(F.FolderPath, F.Name))

LoopFolders Folders

Set F = Nothing
Set Folders = Nothing
Set objOutlook = Nothing
End If
End Sub

Private Function GetDesktopFolder()
Dim objShell
Set objShell = CreateObject("WScript.Shell")
GetDesktopFolder = objShell.SpecialFolders("Desktop")
Set objShell = Nothing
End Function

Private Sub LoopFolders(Folders)
Dim F

For Each F In Folders
WriteToATextFile (CreateFolderTree(F.FolderPath, F.Name))
LoopFolders F.Folders
Next
End Sub

Private Sub WriteToATextFile(OLKfoldername)
Dim objFSO, objTextFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(gFileName, 8, True)
objTextFile.WriteLine (OLKfoldername)
objTextFile.Close
Set objFSO = Nothing
Set objTextFile = Nothing
End Sub

Private Function CreateFolderTree(OLKfolderpath, OLKfoldername)
If gCreateTree = False Then
CreateFolderTree = Mid(OLKfolderpath, 3)
Else
Dim i, x, OLKprefix
i = Len(OLKfolderpath) - Len(Replace(OLKfolderpath, "\", ""))

    For x = gBase To i
OLKprefix = OLKprefix & "-"
Next

CreateFolderTree = OLKprefix & OLKfoldername
End If
End Function

3。按 F5 运行此VBA的关键。在打开的“选择文件夹”对话框中，下一步，请选择要导出和打印其文件夹列表的电子邮件帐户，然后单击 OK 按钮。看截图：

4.然后出现“输出文件夹树”对话框。请点击 USB MIDI（XNUMX通道） 按钮或没有按钮，根据需要。