excel做实时更新的文件夹目录

第一次做分享，不妥之处请见谅。经验分享VBA源码来自网络。

打开EXCEL,新建空白工作薄。ALT+F11或者依次点击视图→宏→查看宏→输入宏名ml→创建

粘贴以下代码到右侧代码窗口

Sub ml()

On Error Resume Next

zzml = "请选择要制作目录的文件夹"

Set mlzz = CreateObject("shell.Application").BrowseForFolder(0, zzml, &H1)

lj = mlzz.Self.Path

Cells(1, 1) = "序号"

Cells(1, 2) = "文件名称"

Cells(1, 3) = "文件类型"

Dim wj As String

wj = Dir(lj & "*.*")

Do

Cells(([A65536].End(xlUp).Row + 1), 1) = [A65536].End(xlUp).Row

Cells(([C65536].End(xlUp).Row + 1), 3).FormulaR1C1 = "=MID(RC[-1],FIND(""."",RC[-1])+1,LEN(RC[-1]) - FIND(""."",RC[-1]))"

Cells(([B65536].End(xlUp).Row + 1), 2).SelectActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=wj, TextToDisplay:=wj

wj = Dir

Loop Until Len(wj) = 0

Columns("A:C").Select

Columns("A:C").EntireColumn.AutoFit

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

End With

Cells(1, 1).Select

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:=lj & "" & mlzz.Self.Name & "目录.xls"

ActiveWindow.Close

Application.DisplayAlerts = True

Workbooks.Add

End Sub关闭宏窗口，回到工作薄。ALT+F8或者依次点击视图→宏→查看宏→ml→执行

关闭宏窗口，回到工作薄。ALT+F8或者依次点击视图→宏→查看宏→ml→执行

关闭宏窗口，回到工作薄。ALT+F8或者依次点击视图→宏→查看宏→ml→执行

关闭宏窗口，回到工作薄。ALT+F8或者依次点击视图→宏→查看宏→ml→执行

关闭宏窗口，回到工作薄。ALT+F8或者依次点击视图→宏→查看宏→ml→执行

选择所需要制作目录的文件夹

在所选文件夹下就会生成一个目录

谢谢观看，再见