我有一个Excel文件，其中列出了我的C（超过600个文件夹）下的文件夹名称。如果创建了新文件夹，此列表将自动更新。如果文件夹已经存在，则不执行任何操作。
在Outlook中，在收件箱-文件夹“生产”下，我想创建一个新的文件夹（如果它不存在），名称来自A列。
Outlook中的每个文件夹都应该使用相同的子文件夹结构创建。
对于Excel/列A下的每个Vsl名称，根据随附结构创建子文件夹：

我找到了下面的宏。

Option Explicit

Public Sub MoveSelectedMessages()
    Dim objParentFolder As Outlook.Folder ' parent
    Dim newFolderName 'As String
    Dim strFilepath
    
    Dim xlApp As Object 'Excel.Application
    Dim xlWkb As Object ' As Workbook
    Dim xlSht As Object ' As Worksheet
    Dim rng As Object 'Range

    Set xlApp = CreateObject("Excel.Application")
    
    strFilepath = xlApp.GetOpenFilename
    If strFilepath = False Then
        xlApp.Quit
        Set xlApp = Nothing
        Exit Sub
    End If
      
    Set xlWkb = xlApp.Workbooks.Open(strFilepath)
    Set xlSht = xlWkb.Worksheets(1)
    Dim iRow As Integer
     
    iRow = 2
    
    'select starting parent
    Set objParentFolder = Application.ActiveExplorer.CurrentFolder
 
    Dim parentname

    While xlSht.Cells(iRow, 1) <> ""
        parentName = xlSht.Cells(iRow, 1)
        newFolderName = xlSht.Cells(iRow, 2)
    
        If parentName = "Inbox" Then
            Set objParentFolder = Session.GetDefaultFolder(olFolderInbox)
        Else
            Set objParentFolder = objParentFolder.Folders(parentName)
        End If
        On Error Resume Next

        Dim objNewFolder As Outlook.Folder
        Set objNewFolder = objParentFolder.Folders(newFolderName)

        If objNewFolder Is Nothing Then
            Set objNewFolder = objParentFolder.Folders.Add(newFolderName)
        End If
    
        iRow = iRow + 1

        ' make new folder the parent
        ' Set objParentFolder = objNewFolder
    
        Set objNewFolder = Nothing
    Wend
     
    xlWkb.Close
    xlApp.Quit
    Set xlWkb = Nothing
    Set xlApp = Nothing
    Set objParentFolder = Nothing
End Sub