为文件夹内文件生成目录(带链接)
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
Sub ml()
On Error Resume Next '如果出现错误,继续运行下面的代码
zzml = "选择要制作目录的文件夹" '以下代码弹出一个选择文件夹对话框
Set mlzz = CreateObject("Shell.Application").BrowseForFolder(0, zzml, &H1)
lj = mlzz.Self.Path '将选中文件夹的路径传递给变量lj
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 '从下向上判断A列有数据的行,并在其下一单元格中输入行序号作为文件序号
Cells(([C65536].End(xlUp).Row + 1), 3).FormulaR1C1 = "=MID(RC[-1],FIND(""."",RC[-1])+1,LEN(RC[-1])-FIND(""."",RC[-1]))" '从下向上判断C列有数据的行,并在其下一单元格中输入公式,用于提出文件的扩展名,便于后续排序操作
Cells(([B65536].End(xlUp).Row + 1), 2).Select '从下向上判断B列有数据的行,并选中其下一单元格
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=wj, TextToDisplay:=wj '在上述单元格中输入文件名称
wj = Dir '进入下一个循环
Loop Until Len(wj) = 0 '直到文件名称字节为0(即无文件)时,终止循环
Columns("A:C").Select '以下代码将列设置为最合适列宽及水平居中格式
Columns("A:C").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Cells(1, 1).Select '选中A1单元格
Application.DisplayAlerts = False '进行下面保存时直接覆盖以前的同名文档,不给出提示
ActiveWorkbook.SaveAs Filename:=lj & "\" & & "目录.xls" '保存目录文档
Application.DisplayAlerts = True '恢复覆盖文档时提示
End Sub