用戶226428970683
謝謝您的信任！
一鍵自動生成文件樹形目錄需藉助Excel VBA宏代碼實現！下載地址見文章末尾！
文件目錄自動生成
這個案例較為複雜，我們無須重複造輪子，只需下載成品文件修改相應代碼即可實現私人定製！
關鍵VBA代碼如下：
- 獲取文件夾
Private Sub CommandButton1_Click()
Call add
End Sub
Sub add()
Dim Msg, Style, Title, Response
Dim TEMP
tmp_rows = Sheet3.Range("D1").Value
Call test
If Sheet3.Cells(1, 2) = "" Then
Sheet3.Cells(1, 2) = ct_spath_tmp
Else
If Application.WorksheetFunction.CountIf(Sheet3.Range("B:B"), ct_spath_tmp) = 0 Then
Sheet3.Cells(Sheet3.Range("b65536").End(xlUp).Row + 1, 2) = ct_spath_tmp
End If
End If
End Sub
- 摺疊文件夾
Private Sub CommandButton2_Click() '摺疊文件夾
Dim total_rows#
total_rows = Sheet3.Cells(1, 4).Value
Application.ScreenUpdating = False
For temrows = 2 To total_rows
If Range("j" & temrows).Interior.ColorIndex = -4142 Then
ActiveSheet.Range("j" & temrows).EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub
- 展開文件夾
Private Sub CommandButton3_Click() '展開文件夾
展開文件夾
End Sub
Private Function 展開文件夾()
ActiveSheet.usedrange.Select
Selection.EntireRow.Hidden = False
[a1].Select
End Function
- 清空目錄
Private Sub CommandButton4_Click()
Sheet3.Range(Sheet3.Cells(1, 2), Sheet3.Cells(Sheet3.Range("B65536").End(xlUp).Row, 2)).clear
Call clear
End Sub
- 手動更新
Private Sub CommandButton5_Click() '更新目錄
Dim p#, TEMP#
Call clear
i = 2
tmp_rows = 2
TEMP = Sheet3.Range("b65536").End(xlUp).Row
For p = 1 To TEMP
spath = Sheet3.Cells(p, 2)
spath_tmp = spath
If spath = "" Then Exit Sub
Call 展開文件夾
Call 獲得當前文件夾名
spath = spath & "\\"
Call 獲取當前文件名
Call getfolder(spath)
Sheet3.Range("D1") = i
Next
Call 設置目錄線
End Sub
- 自動更新
Private Sub CheckBox1_Click()
If Sheet2.CheckBox1.Value = True Then
Call update
End If
End Sub
Function update()
Dim p#, TEMP#
Call clear
i = 2
tmp_rows = 2
TEMP = Sheet3.Range("b65536").End(xlUp).Row
For p = 1 To TEMP
spath = Sheet3.Cells(p, 2)
spath_tmp = spath
If spath = "" Then Exit Function
Call 展開文件夾
Call 獲得當前文件夾名
spath = spath & "\\"
Call 獲取當前文件名
Call getfolder(spath)
Sheet3.Range("D1") = i
Next
Call 設置目錄線
End Function
《文件目錄自動生成(含文件鏈接).xlsm》下載地址如下：
鏈接：https://pan.baidu.com/s/1Ecn9vAhSqGsBFmAmsM4dhA
提取碼：9kj2
