請使用Excel VBA宏和顯示用樹狀視圖文件夾和文件的超鏈接

-4

我想通過閱讀以下路徑請使用Excel VBA宏和顯示用樹狀視圖文件夾和文件的超鏈接

 /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 macro.See

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

所以請爲vba noob提供幫助。

來源

2014-02-07 Sai Ye Yan Naing Aye

您是否已經有一些代碼？ – bmgh1985

你沒有問過[類似的問題]（http://stackoverflow.com/questions/21396253/vba-tree-view-from-string/）？ –

@PankajJaju不相似，仔細閱讀我的問題。按照這個http://stackoverflow.com/questions/21396253/vba-tree-view-from-string/我想添加超鏈接到最後的文件和文件夾（標有明星）這是我的問題。 –

我認爲應該這樣做。該宏將從單元格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

來源

2014-02-10 08:57:02 Taosique

請使用Excel VBA宏和顯示用樹狀視圖文件夾和文件的超鏈接

回答

相關問題