使用excel vba宏创建文件夹和文件,并显示树视图和超链接 [英] Make folders and files using excel vba macro and display with tree view and hyperlinks
问题描述
我想通过阅读以下路径来创建文件夹和文件
I would like to make folder and file by reading the following paths
/project/tags/folder2/command.txt
/project/branches/folder1/folder1.1/Notes.docx
并构造文件夹和驱动器下的文件D:\喜欢这个
and construct folders and files under drive D:\ likes this
project
tags
folder2
command.txt
branches
folder1
folder1.1
Notes.docx
。然后使用此物理结构使用超级链接键入树视图(请假设我使用vba宏在excel表格中的最后文件和文件夹标记*为单词具有超链接的名称*)。参阅
.Then use this physical structure to type tree view with hyperlinks(Please assume I mark * for the names that words have hyperlinks) at last files and folders in excel sheet using vba macro.See
project
|_tags
| |_folder2*
| |_command.txt*
|_branches
| |_folder1
| |_folder1.1*
| |_Notes.docx*
所以请帮助vba noob。
So please help something for vba noob.
推荐答案
我认为应该这样做。
此宏将从单元格 A1
中获取文件夹路径,并以超链接递归列出其内容和子文件夹内容。
更新:已修复,现在正在运行。 :)
I think that should do the trick.
This macro will take folder path from cell A1
and list recursively its contents and subfolder contents with hyperlinks.
Update: fixed, now it's working. :)
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
这篇关于使用excel vba宏创建文件夹和文件,并显示树视图和超链接的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!