文件夹下的所有工作簿内和所有工作表目录

'在文件夹内新建一个表，复制粘贴此代码，运行宏。

Sub OPIONA()

'On Error Resume Next

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Application.ScreenUpdating = False '关闭屏幕刷新

Application.DisplayAlerts = False '关闭提示

If MsgBox("需要操作的数据表是：EXCEL2003 格式，请选择：是！" & Chr(13) & "" & Chr(13) & "需要操作的数据表是：EXCEL2007 格式，请选择：否！", vbYesNo, "北极狐提示！！") = vbYes Then

S = "\*.xls"

ss = 4

Else

S = "\*.xlsx"

ss = 5:

End If

t = Timer '记录开始时间

f = Dir(ThisWorkbook.Path & S) '生成查找EXCEL的目录

n = 2 '开始记录工作簿名和工作表名的开始行

Do While f > " " '在目录中循环

If f <> ThisWorkbook.Name Then '如果不是打开的工作簿

Set xlBook = Workbooks.Open(ThisWorkbook.Path & "\" & f) '打开已经存在的EXCEL工件簿文件

For Each sh In xlBook.Worksheets '遍历工作表

Windows(ThisWorkbook.Name).Activate '回到操作主表界面

If n = 2 Then Sheets(1).Cells(1, 1) = "工作簿名": Sheets(1).Cells(1, 2) = "工作表名": '加入标题行

Sheets(1).Cells(n, 1) = Mid(f, 1, Len(f) - ss) '所在工作簿名

Sheets(1).Cells(n, 2) = sh.Name '所在工作表名

n = n + 1

Next

Windows(f).Close (False) '关闭工作簿，不保存

End If

f = Dir

Loop

Application.ScreenUpdating = True

Application.DisplayAlerts = True

MsgBox "一共用时：" & Timer - t & " 秒", , "北极狐提示!!"

End Sub