使用 excel vba 宏创建文件夹和文件，并以树视图和超链接显示答案

【问题标题】：Make folders and files using excel vba macro and display with tree view and hyperlinks使用 excel vba 宏创建文件夹和文件，并以树视图和超链接显示
【发布时间】：2014-03-04 13:27:53
【问题描述】：

我想通过阅读以下路径来制作文件夹和文件

       /project/tags/folder2/command.txt
       /project/branches/folder1/folder1.1/Notes.docx

并在D盘下构造文件夹和文件：\喜欢这样

      project
          tags
              folder2
                   command.txt
          branches
              folder1
                    folder1.1
                           Notes.docx

。然后使用这个物理结构在excel表格中使用vba宏在最后的文件和文件夹中键入带有超链接的树视图（请假设我标记*表示单词具有超链接的名称）。参见

      project
         |_tags
         |   |_folder2*
         |         |_command.txt*
         |_branches
         |     |_folder1
         |           |_folder1.1*
         |                 |_Notes.docx*

所以请为 vba noob 提供一些帮助。

【问题讨论】：

你已经有一些代码了吗？
你不是问similar question吗？
@PankajJaju 不相似，请仔细阅读我的问题。根据此stackoverflow.com/questions/21396253/vba-tree-view-from-string 我想将超链接添加到最后一个文件和文件夹（标有星号），这是我的问题。
你看过我下面的解决方案了吗？
你的问题太宽泛了。您应该学习 VBA，而不是要求其他人为您工作。 whathaveyoutried.com 然后，当某些特定的事情给您带来问题而您找不到答案时，请回到这里。

标签： excel treeview vba

【解决方案1】：

我认为这应该可以解决问题。该宏将从单元格A1 获取文件夹路径，并通过超链接递归地列出其内容和子文件夹内容。 更新： 已修复，现在可以使用了。 :)

Public Position As Integer
Public Indent As Integer

Sub ListFileTree()

Position = 0
Indent = 0

Call RecurseFolderList(Range("A1").Value)

End Sub

Private Sub ClearFormatting(Rng As Range)

    Rng.Formula = Rng.Value2
    Rng.Font.ColorIndex = xlAutomatic
    Rng.Font.Underline = xlUnderlineStyleNone

End Sub

Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Function RecurseFolderList(FolderName As String) As Boolean
    On Error Resume Next
    Dim FSO, NextFolder, FolderArray, FileArray, NextFile
    Dim OriginalRange As Range
    Dim RemoveHyperlink As Boolean
    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Err.Number > 0 Then
        RecurseFolderList = False
    Exit Function

    End If

    On Error GoTo 0
    If FSO.FolderExists(FolderName) Then

        Set NextFolder = FSO.GetFolder(FolderName)
        Set FolderArray = NextFolder.SubFolders
        Set FileArray = NextFolder.Files

        RemoveHyperlink = False
        Set OriginalRange = Range("A2").Offset(Position - 1, Indent)

        Indent = Indent + 1

        For Each NextFolder In FolderArray

            Range("A2").Offset(Position, Indent).Formula = "=HYPERLINK(""" & NextFile & """,""" & UCase(GetFilenameFromPath(NextFolder)) & """)"
            Position = Position + 1

            RecurseFolderList (NextFolder)

            RemoveHyperlink = True
        Next

        For Each NextFile In FileArray

            Range("A2").Offset(Position, Indent).Formula = "=HYPERLINK(""" & NextFile & """,""" & GetFilenameFromPath(NextFile) & """)"
            Position = Position + 1

            RemoveHyperlink = False

            DoEvents
        Next

        If RemoveHyperlink Then
            Call ClearFormatting(OriginalRange)
        End If

        Set NextFolder = Nothing
        Set FolderArray = Nothing
        Set FileArray = Nothing
        Set NextFile = Nothing

    Else
        RecurseFolderList = False
    End If

    Set FSO = Nothing
    Indent = Indent - 1

End Function

【讨论】：