Vba Outlook 2007多选文件夹

第一次提问：D

我一直在为Outlook 2007编写一个Marco，让用户选择一个文件夹，然后使用该文件夹将所有邮件移出该文件夹，并将其移动到个人Arhcive文件夹中，其中使用所选文件夹名称作为个人文件夹下的目标

e、 g

用户选择名称为“Test”的randon文件夹

马可将被预先映射到个人文件夹，然后它将定位具有相同名称的子文件夹并移动邮件项目

我的问题是:

我目前正在使用“PickFolder”语法来使用选择文件夹，我要做的是使用多选文件夹表单：

• 如何使用Combobox和listbox表单使所有Fodler的Mapi以自定义表单显示

我知道这将只在一个级别，但这是我所需要的全部，因为200多个文件夹都在一个级别

正如代码所示，它一次只处理一个文件夹，效果非常出色，但我希望增加反

---

谢谢你

我已经解决了获取文件夹完整列表（代码如下）的问题，但是如果您在其他部分需要更多帮助，请添加评论，我将在我的回答上进行扩展

我不明白你会用组合框做什么。因此，对于这个示例，我创建了一个表单并添加了一个列表框（称为

ListBox1

）。下面的代码将用所选文件夹中所有文件夹的名称填充列表框。请阅读评论以了解您还可以做些什么（例如，通过子文件夹递归-我知道在这种情况下不需要这样做）

如果您需要更多帮助或信息，请务必告诉我

Private Sub PopulateListBoxWithFolders()

    Dim objApp As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder

    ' Clear current contents of listbox
    ListBox1.Clear

    Set objApp = New Outlook.Application

    Set objNamespace = objApp.GetNamespace("MAPI")

    ' Allow user to select folder.
    ' Replace this with either objNamespace.GetDefaultFolder(...) or objNamespace.GetFolderFromID(...)
    ' to avoid the user having to select a folder
    Set objFolder = objNamespace.PickFolder

    ' See if the user cancelled or no folder found
    If Not objFolder Is Nothing Then
        ' Addition of true here recurses through all subfolders
        ProcessFolder objFolder ', True
    End If

End Sub

' Populates the ListBox with the folders. Optionally you can recurse all folders
Sub ProcessFolder(objStartFolder As Outlook.MAPIFolder, Optional blnRecurseSubFolders As Boolean = False, Optional strFolderPath As String = "")

    Dim objFolder As Outlook.MAPIFolder

    Dim i As Long

     ' Loop through the items in the current folder
    For i = 1 To objStartFolder.Folders.Count

        Set objFolder = objStartFolder.Folders(i)

        ' Populate the listbox
        ListBox1.AddItem ListBox1.Text + objFolder.FolderPath

        If blnRecurseSubFolders Then
            ' Recurse through subfolders
            ProcessFolder objFolder, True, strFolderPath + "\" + objFolder.FolderPath
        End If
    Next

End Sub

如果您需要代码来标识多选列表框中的选定项，请点击此处。要使列表框多选，应将表单编辑器中的

multiselect

属性设置为

1-fmMultiSelectMulti

Private Sub btnOK_Click()
    Dim i As Long

    ' Loop through all items in the listbox identifying those that are selected
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ' Here goes the code to act on the selected item
                ' In the example below it outputs to the Immediate window
                Debug.Print .List(i)
            End If
        Next i
    End With

End Sub

---

我已经解决了获取文件夹完整列表（代码如下）的问题，但是如果您需要其他部分的更多帮助，请添加注释，我将在我的答案上进行扩展

我不明白你会用组合框做什么。因此，对于这个示例，我创建了一个表单并添加了一个列表框（称为

ListBox1

）。下面的代码将用所选文件夹中所有文件夹的名称填充列表框。请阅读评论以了解您还可以做些什么（例如，通过子文件夹递归-我知道在这种情况下不需要这样做）

如果您需要更多帮助或信息，请务必告诉我

Private Sub PopulateListBoxWithFolders()

    Dim objApp As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder

    ' Clear current contents of listbox
    ListBox1.Clear

    Set objApp = New Outlook.Application

    Set objNamespace = objApp.GetNamespace("MAPI")

    ' Allow user to select folder.
    ' Replace this with either objNamespace.GetDefaultFolder(...) or objNamespace.GetFolderFromID(...)
    ' to avoid the user having to select a folder
    Set objFolder = objNamespace.PickFolder

    ' See if the user cancelled or no folder found
    If Not objFolder Is Nothing Then
        ' Addition of true here recurses through all subfolders
        ProcessFolder objFolder ', True
    End If

End Sub

' Populates the ListBox with the folders. Optionally you can recurse all folders
Sub ProcessFolder(objStartFolder As Outlook.MAPIFolder, Optional blnRecurseSubFolders As Boolean = False, Optional strFolderPath As String = "")

    Dim objFolder As Outlook.MAPIFolder

    Dim i As Long

     ' Loop through the items in the current folder
    For i = 1 To objStartFolder.Folders.Count

        Set objFolder = objStartFolder.Folders(i)

        ' Populate the listbox
        ListBox1.AddItem ListBox1.Text + objFolder.FolderPath

        If blnRecurseSubFolders Then
            ' Recurse through subfolders
            ProcessFolder objFolder, True, strFolderPath + "\" + objFolder.FolderPath
        End If
    Next

End Sub

如果您需要代码来标识多选列表框中的选定项，请点击此处。要使列表框多选，应将表单编辑器中的

multiselect

属性设置为

1-fmMultiSelectMulti

Private Sub btnOK_Click()
    Dim i As Long

    ' Loop through all items in the listbox identifying those that are selected
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                ' Here goes the code to act on the selected item
                ' In the example below it outputs to the Immediate window
                Debug.Print .List(i)
            End If
        Next i
    End With

End Sub

---

谢谢吉姆，我会试一试的。我不是很擅长创建一个用户表单，但我会尝试让它工作。谢谢Jim，我会尝试一下。我不太擅长创建用户表单，但我会尝试让它正常工作。