当然可以通过Adobe JSO来实现你需要的操作！我来一步步帮你拆解解决这些问题，同时优化你之前的导入代码：

一、获取Portfolio中现有子文件夹的列表 #

PDF Portfolio的JSO对象里，doc.dataObjects集合包含了所有的文件和文件夹对象，其中文件夹的isFolder属性为true。我们可以遍历这个集合来筛选出所有子文件夹：

Sub GetPortfolioFolders()
    Dim acroApp As Object
    Dim acroDoc As Object
    Dim dataObj As Object
    Dim folderList As Collection
    
    Set acroApp = CreateObject("AcroExch.App")
    Set acroDoc = CreateObject("AcroExch.PDDoc")
    Set folderList = New Collection
    
    ' 替换为你的Portfolio文件路径
    If acroDoc.Open("C:\YourTargetPortfolio.pdf") Then
        ' 获取JSO核心对象
        For Each dataObj In acroDoc.GetJSObject.dataObjects
            ' 筛选出文件夹类型的对象
            If dataObj.isFolder Then
                folderList.Add dataObj.name & " | 路径: " & dataObj.path
            End If
        Next dataObj
        
        ' 输出结果到VBA立即窗口
        Dim folderItem As Variant
        For Each folderItem In folderList
            Debug.Print folderItem
        Next folderItem
        
        acroDoc.Close
    End If
    
    acroApp.Exit
    Set acroDoc = Nothing
    Set acroApp = Nothing
End Sub

这段代码会把所有子文件夹的名称和路径收集起来，输出到VBA的立即窗口，你可以根据需求修改成存入数组或工作表的形式。

二、创建新的子文件夹 #

用JSO的createFolder方法就能直接创建文件夹，支持根目录创建和嵌套创建：

Sub CreatePortfolioFolder()
    Dim acroApp As Object
    Dim acroDoc As Object
    Dim jso As Object
    
    Set acroApp = CreateObject("AcroExch.App")
    Set acroDoc = CreateObject("AcroExch.PDDoc")
    
    If acroDoc.Open("C:\YourTargetPortfolio.pdf") Then
        Set jso = acroDoc.GetJSObject
        
        ' 在根目录创建新文件夹
        jso.createFolder("NewRootFolder")
        
        ' 嵌套创建：在已有的ParentFolder下新建子文件夹（ParentFolder需先存在）
        ' jso.createFolder("ParentFolder/NestedSubFolder")
        
        ' 必须保存才能生效，1代表完整保存模式
        acroDoc.Save 1, "C:\YourPortfolio_Updated.pdf"
        acroDoc.Close
    End If
    
    acroApp.Exit
    Set jso = Nothing
    Set acroDoc = Nothing
    Set acroApp = Nothing
End Sub

注意：创建后一定要调用Save方法，否则修改不会被写入PDF文件。

三、优化子文件导入代码（解决无文件夹+硬编码问题） #

针对你之前遇到的无文件夹时代码失效、硬编码首个文件夹的问题，我们可以先检查目标文件夹是否存在，不存在则自动创建，再执行导入：

Sub ImportFileToPortfolio()
    Dim acroApp As Object
    Dim acroDoc As Object
    Dim jso As Object
    Dim targetFolderName As String
    Dim isFolderExists As Boolean
    Dim dataObj As Object
    
    Set acroApp = CreateObject("AcroExch.App")
    Set acroDoc = CreateObject("AcroExch.PDDoc")
    targetFolderName = "DefaultImportFolder" ' 可自定义目标文件夹名称
    
    If acroDoc.Open("C:\YourTargetPortfolio.pdf") Then
        Set jso = acroDoc.GetJSObject
        
        ' 检查目标文件夹是否存在
        isFolderExists = False
        For Each dataObj In jso.dataObjects
            If dataObj.isFolder And dataObj.name = targetFolderName Then
                isFolderExists = True
                Exit For
            End If
        Next dataObj
        
        ' 不存在则自动创建
        If Not isFolderExists Then
            jso.createFolder(targetFolderName)
        End If
        
        ' 导入文件到指定文件夹，最后一个参数是目标文件夹路径
        jso.importDataObject "subfile.txt", , , targetFolderName & "/"
        
        ' 保存修改
        acroDoc.Save 1, "C:\YourPortfolio_Imported.pdf"
        acroDoc.Close
    End If
    
    acroApp.Exit
    Set jso = Nothing
    Set acroDoc = Nothing
    Set acroApp = Nothing
End Sub

额外注意事项 #

• 确保你的Acrobat PRO DC已正常安装，且VBA代码有文件系统的读写权限
• 如果Portfolio里有大量对象，遍历dataObjects时可以适当添加性能优化（比如提前获取集合长度）
• 所有修改操作后必须调用Save方法，否则不会生效

内容的提问来源于stack exchange，提问作者srclark