VBA移动电子邮件文件夹和内容

Question

我很难将脚本移动到一个不同的父文件夹移动电子邮件文件夹（&内容）。该文件夹在父收件箱中没有。我对VBA有一个基本的，自学成才的理解。
例如。 ThisOutlookSession/[FolderA]移动到ThisOutlookSession/Inbox/[FolderA]
我发现了很多移动电子邮件但不是文件夹的例子。

在此先感谢您的帮助。

编辑：

Private Sub ImportFolder() <br> 
''''''''' 
'' Assume for this example so im not overloading code that I have already created the CSV that im drawing data from, opened in excel & this Macro is running from Outlook 
''''''''' 

Dim xlWkb As Object ' As Workbook 
Dim xlSht As Object ' As Worksheet 
Set xlSht = xlWkb.Worksheets(1) 'set active being first worksheet 
Dim iRow As Integer 
Dim ChilCol As Integer 
Dim parentFolderName 
iRow = 1 'set start a Row1 
ChilCol = 1 'set start as ColA 

'Set Parent as Static nomination in head macros 

While xlSht.Cells(iRow, 1) <> "" 'while Parent is not blank 

If ChilCol <= 1 Then 
Set objParentFolder = Session.GetDefaultFolder(olFolderInbox) 
    Else 
parentFolderName = xlSht.Cells(iRow, ChilCol - 1) 'set the parent to be the previous Column 

Set objParentFolder = objParentFolder.Folders(parentFolderName) 
End If 

'Set name for the new folder 
    newFolderName = xlSht.Cells(iRow, ChilCol) 

On Error Resume Next 

'''''''''''''''''''''''''''''''''''''' 
Dim objNewFolder As Outlook.Folder 

''''''''''''''''''''''''''''''''''''''' 
If newFolderName = "Inbox" Then 
newFolderName = Nothing 
End If 

'If ParentFolder = newFolderName 
    ' 

Set objNewFolder = objParentFolder.Folders(newFolderName) 

'' This is where I am unsure - I have a Archive email folder on same hierarchy as Inbox 
'' due to how mobile Outlook displays folders. This part of the code should check that if 
'' the Parent Folder for the new folder to be mapped in then move the Folder in Archive to Inbox\SubFolder 

     If objNewFolder.Parent = "zArchive" And objNewFolder.Parent = parentFolderName Then 
      objNewFolder.MoveTo Session.GetDefaultFolder(olFolderInbox) 
     End If 

'If no issues, then create the Folder 
If objNewFolder Is Nothing Then 'if no value 
    Set objNewFolder = objParentFolder.Folders.Add(newFolderName) 'add folder 
End If  

' make new folder the parent 
Set objParentFolder = objNewFolder 
    If xlSht.Cells(iRow, ChilCol) = "" Then ''unless blank 
     iRow = iRow + 1 'new row 
     ChilCol = 0 'reset ChildColumn 
    End If 
    ChilCol = ChilCol + 1 ' move to next nesting column 
    Set objNewFolder = Nothing 'required to reset the New Folder name 
Wend 

xlWkb.Close 
xlApp.Quit 
Set xlWkb = Nothing 
Set xlApp = Nothing 
Set objParentFolder = Nothing 
End Sub 

Answer 1

可以使用Folder.MoveTo方法，一个文件夹移动到指定的目标文件夹。

Sub MoveFolder() 
    Dim myNameSpace As Outlook.NameSpace 
    Dim myFolder As Outlook.Folder 
    Dim myNewFolder As Outlook.Folder 

    Set myNameSpace = Application.GetNamespace("MAPI") 
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts) 
    Set myNewFolder = myFolder.Folders.Add("My Test Contacts") 
    myNewFolder.MoveTo myNameSpace.GetDefaultFolder(olFolderInbox) 
End Sub 

您可能会发现文章Getting Started with VBA in Outlook 2010对您有帮助。