Outlook 2010 VBA将选定的电子邮件保存到该对话中的其他电子邮件已被移动到该文件夹

我正在尝试编写一种自动提交电子邮件的方法 . 我将所有电子邮件归档到收件箱中的一组非常详细的子文件夹中 . 我有很多子文件夹可以帮助我整理我的电子邮件，但这会导致花费大量额外时间来清理我的收件箱（通过将电子邮件归档到相关的子文件夹） . 我想自动执行此操作，以便我可以在收件箱中选择一封电子邮件并运行宏来显示已在同一会话线程中存储电子邮件的文件夹列表，并允许我选择保存所选电子邮件的文件夹至 . 我发现了几个接近的示例代码但没有真正做到这一点的动作 .

http://blog.saieva.com/2010/03/27/move-messages-to-folders-with-outlook-vba/显示了当您知道要将电子邮件发送到哪个子文件夹时如何将邮件移动到子文件夹 . 这对我的情况不起作用，因为我希望宏给我一个"recommended"文件夹列表 .

我认为下面的代码可能是一个很好的起点，如果我能找到一种方法来遍历所选电子邮件的对话的每个“孩子”（不确定是否是正确的单词）并将所选的电子邮件移动到该文件夹如果用户在MsgBox中选择“是” .

Public Sub GetItemsFolderPath()
  Dim obj As Object
  Dim F As Outlook.MAPIFolder
  Dim convItemFolders As Outlook.MAPIFolder
  Dim msg$
  Dim rootitemcount

  Set obj = Application.ActiveWindow
  If TypeOf obj Is Outlook.Inspector Then
    Set obj = obj.CurrentItem
  Else
    Set obj = obj.Selection(1)
  End If

  Set F = obj.Parent
  msg = " The path is: " & F.FolderPath & rootitemcount & vbCrLf
  msg = msg & "Switch to the folder?"
  If MsgBox(msg, vbYesNo) = vbYes Then
    Set Application.ActiveExplorer.CurrentFolder = F
  End If
End Sub

我无法整合可以使这项工作的循环 . 有没有人对如何使用上述或任何其他选项有任何建议？

编辑

不确定如何在没有“回答”我自己的问题的情况下展示我的下一步 . 这是我的第一个问题，所以我还不知道所有的规则，如果这是错的，请告诉我，以便我可以解决它 . 我还没完成，但是在下面的答案的帮助下，我已经接近了很多 . 以下是我更新的代码：

Public Sub GetConverstationInformation()

    Dim host As Outlook.Application
    Set host = ThisOutlookSession.Application

    ' Check for Outlook 2010
    If Left(host.Version, 2) = "14" Then
        Dim selectedItem As Object
        Dim theMailItem As Outlook.mailItem

        ' Get the user's currently selected item.
        Set selectedItem = host.ActiveExplorer.Selection.item(1)

        ' Check to see if the item is a MailItem.
        If TypeOf selectedItem Is Outlook.mailItem Then
            Set theMailItem = selectedItem
            ' Check to see that the item's current folder
            ' has conversations enabled.
            Dim parentFolder As Outlook.folder
            Dim parentStore As Outlook.store
            Set parentFolder = theMailItem.Parent
            Set parentStore = parentFolder.store
            If parentStore.IsConversationEnabled Then
                ' Try and get the conversation.
                Dim theConversation As Outlook.conversation
                Set theConversation = theMailItem.GetConversation
                If Not IsNull(theConversation) Then
                    ' Outlook provides a table object
                    ' the contains all of the items in the
                    ' conversation.
                    Dim itemsTable As Outlook.table
                    Set itemsTable = theConversation.GetTable

                    ' Get the Root Items
                    ' Enumerate the list of items
                    ' only writing out data for MailItems.
                    ' A conversation can contain other items
                    ' like MeetingItems.
                    ' Then use a helper method and recursion
                    ' to walk all the items in the conversation.
                    Dim group As Outlook.simpleItems
                    Set group = theConversation.GetRootItems
                    Dim obj As Object
                    Dim fld As Outlook.folder
                    Dim mi As Outlook.mailItem
                    'Dim i As Long
                    For Each obj In group
                        If TypeOf obj Is Outlook.mailItem Then
                        Set mi = obj
                        Set fld = mi.Parent

                   'For i = 1 To group.Count
                        Me.ListBox1.AddItem fld.Name

                'mi.Sender & _
                    '" sent the message '" & mi.Subject & _
                    '"' which is in '" &
                     '& "'."
                 'Next i
                        End If
                            GetConversationDetails mi, theConversation
                   Next obj
                Else
                    MsgBox "The currently selected item is not a part of a conversation."
                End If
            Else
                MsgBox "The currently selected item is not in a folder with conversations enabled."
            End If
        Else
            MsgBox "The currently selected item is not a mail item."
        End If
    Else
        MsgBox "This code only works with Outlook 2010."
    End If
End Sub

Private Sub GetConversationDetails(anItem As Object, theConversation As Outlook.conversation)
    Dim group As Outlook.simpleItems
    Set group = theConversation.GetChildren(anItem)

    If group.Count > 0 Then
        Dim obj As Object
        Dim fld As Outlook.folder
        Dim mi As Outlook.mailItem
         'Dim i As Long
        'For i = 1 To group.Count(obj)
        For Each obj In group
            If TypeOf obj Is Outlook.mailItem Then

                Set mi = obj
                Set fld = mi.Parent
                'Dim counter

                Me.ListBox1.AddItem fld.Name

                'mi.Sender & _
                    '" sent the message '" & mi.Subject & _
                    '"' which is in '" &
                     '& "'."

            End If
            GetConversationDetails mi, theConversation
        Next obj
        'Next i
    End If
End Sub



Private Sub UserForm_Initialize()
GetConverstationInformation
End Sub

我把它放到带有列表框的用户表单中 . 我的目的是只允许添加唯一的文件夹名称 . 完成后，我想添加一个按钮，可以单击该按钮将所选电子邮件归档到从列表框中选择的文件夹中 . 有没有人在接下来的步骤中有任何笔记/良好的起点？我一直在网上搜索不同的方法，但我不断遇到长子，我不得不想象有一个更优雅的解决方案 . 如果我发现有效的话，我会再次更新 . 再次感谢你的帮助！