excel提取文件夹文件目录

1、以office2010为例，打开excel，点击视图，点击宏的下面黑色三角下拉符号，点击录制宏；然后在关闭录制。

2、按下Alt+F11组合键，双击“模块1”（随意命名），在右侧输入栏输入以下代码：

Sub ml()

On Error Resume Next 

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

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

lj = mlzz.Self.Path 

Cells(1, 1) = "序号" '以下代码在A1、B1、C1单元格中输入列标题文本内容

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

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

Dim wj As String '声明一个变量wj

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).Select 

ActiveSheet.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"

Application.DisplayAlerts = True 

Workbooks.Add

End Sub

3、运行调试以上代码，没有问题后关闭窗口；点击宏，运行刚刚做的“模块1”，然后选择需要建立超级链接目录的文件夹。