Question

我正在尝试在VBA Excel 2007中创建一个新的字符串，它是文件夹路径与子文件夹的组合

有没有办法可以将CurDir（）与folder.path和path.separators结合使用，它们会给出组合字符串的结果？

示例：

\\Tardis\Data\[PATH] = ParentPath
\\Tardis\Data\[PATH]\HELLO = 1st Subfolder
\\Tardis\Data\[PATH]\HELLO\WORLD = 2nd Subfolder

结果：你好世界

Answer 1

我将在此处采用SWAG：我认为您要创建一个字符串，它将目录和子目录名称之间的空格组合在一起。

这是一个脚本，它假定当前目录中有多个子文件夹，并使用FileSystemObject和Folder创建一个名称，如您为每个子文件所描述的那样（保存在数组中并可从数组中访问）。请注意您需要设置对Microsoft Scripting Runtime的引用。我用我的C：驱动器上的My Documents的文件路径测试了它并且它工作了。希望这会有所帮助：

Sub CreateStringsForSubfolders()

    'To use this you need a reference set for Microsoft Scripting Runtime

    '~~>dim variables and set initial values
        Dim fsObject As New FileSystemObject
        Dim fFolder As Folder
            Set fFolder = fsObject.GetFolder("\\Tardis\Data\[PATH]\HELLO")
        Dim fSubfolder As Folder
        Dim aNames() As String
            ReDim aNames(1) As String

    '~~>loop to create name for each subfolder
        For Each fSubfolder In fFolder.SubFolders
            ReDim Preserve aNames(UBound(aNames) + 1)
            aNames(UBound(aNames)) = fFolder.Name & " " & fSubfolder.Name
            Debug.Print aNames(UBound(aNames)) 'press [CTRL + G] to see the names created
        Next

End Sub

以下是符合您要求的修改后的代码。我不确定你在做什么（如果你在你的问题中包含了这些信息可能会有帮助）所以我假设你只是想把子文件夹添加到数组中。如果您确实希望创建的字符串中始终有两个文件夹的名称，请使用Else部分中的注释替代。

Sub CreateStringsForSubfolders2()

    '~~>dim variables and set initial values
        Dim sPath As String
        Dim fsObject As New FileSystemObject
        Dim fFolder As Folder
            Set fFolder = fsObject.GetFolder("\\Tardis\Data\[PATH]")
        Dim fSubfolder As Folder
        Dim fSubfolder2 As Folder
        Dim aNames() As String
            ReDim aNames(1) As String

    '~~>loop to create name for each subfolder and any sub-subfolders
        For Each fSubfolder In fFolder.SubFolders
            ReDim Preserve aNames(UBound(aNames) + 1)
            sPath = fSubfolder.Path
            Set fSubfolder = fsObject.GetFolder(sPath)
            If fSubfolder.SubFolders.Count <> 0 Then
                For Each fSubfolder2 In fSubfolder.SubFolders
                    ReDim Preserve aNames(UBound(aNames) + 1)
                    aNames(UBound(aNames)) = fSubfolder.Name & " " & _
                                                        fSubfolder2.Name
                    Debug.Print aNames(UBound(aNames))
                Next fSubfolder2
            Else
                aNames(UBound(aNames)) = fSubfolder.Name 
                                         'or fFolder.Name & " " fSubfolder.Name
                Debug.Print aNames(UBound(aNames))
            End If
        Next

End Sub

Answer 2

这个代码是为这个解决方案提供的，虽然我有时会得到一个用户定义的类型没有定义错误 - 有谁可以告诉我为什么？

Sub ListFiles()

    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String

    'Assign the top folder to a variable
    strTopFolderName = "\\Tardis\Data\[PATH]\"

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)

    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder)

End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder)

    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim objSubFolder2 As Scripting.Folder
    Dim NextRow As Long
    Dim myString As String

    myString = ""

    'Loop through each file in the folder
    For Each objSubFolder In objFolder.SubFolders
        For Each objSubFolder2 In objSubFolder.SubFolders
            If myString = "" Then
                myString = objSubFolder2.Name
            Else
                myString = objSubFolder.Name & " " & objSubFolder2.Name
                Debug.Print myString
            End If
        Next objSubFolder2

        myString = ""

    Next objSubFolder

End Sub

将子文件夹中的子文件夹名称组合在一起以生成字符串

2 个答案: