1、用 VBA 提取路径下所有工作簿的工作表名（四个方法）方法一：Open 方法思路：遍历路径下的工作簿并用Workbooks.Open 打开，再遍历工作表名 Workbooks.Open 打开一个工作簿。语法表达式.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)表达式 一个代表 Workbo
2、oks 对象的变量。Sub Open 法() Dim arr Dim n, i, j, s$ Dim wb As Workbook, sht As Worksheet, wbk As Workbook Dim myPath$, myFile$ Application.ScreenUpdating = False 禁刷新 Application.Calculation = xlManual 禁计算 Set wbk = ThisWorkbook myPath = ThisWorkbook.Path “ myFile = Dir(myPath “*.xls“) n = CreateObject(“S
3、cripting.FileSystemObject“).GetFolder(myPath).Files.Count - 1 计算文件个数，减 1 不包括自身 ReDim arr(1 To 1000, 1 To n) Do While myFile “ If myFile wbk.Name Then j = j + 1 i = 1 arr(1, j) = Left(myFile, InStrRev(myFile, “.“) - 1) 去后辍 Set wb = Workbooks.Open(myPath “ myFile) 打开工作簿 For Each sht In wb.Sheets 遍历工作表
4、 i = i + 1 arr(i, j) = sht.Name Next wb.Close End If myFile = Dir Loop wbk.ActiveSheet.Range(“A1“).Resize(i, j) = arr 输出 Application.Calculation = xlAutomatic 刷新 Application.ScreenUpdating = True 自动计算End Sub 复制代码方法二：GetObject 方法思路：遍历路径下的工作簿并使用 GetObject 函数访问文件，再获取工作表名 GetObject 返回文件中的 ActiveX 对象的引用。
5、语法GetObject(pathname , class)Sub GetObject 法() Dim cat As Object, MyTable As Object Dim n, i, j, s$ Dim myPath$, myFile$ Application.ScreenUpdating = False 禁刷新 myPath = ThisWorkbook.Path “ myFile = Dir(myPath “*.xls“) n = CreateObject(“Scripting.FileSystemObject“).GetFolder(myPath).Files.Count - 1 计
6、算文件个数，减 1 不包括自身 ReDim arr(1 To 1000, 1 To n) Do While myFile “ If myFile ThisWorkbook.Name Then 不等于本工作簿执行 j = j + 1 i = 1 arr(1, j) = Left(myFile, InStrRev(myFile, “.“) - 1) 去后辍 With GetObject(myPath myFile) 使用 GetObject 函数可以访问文件 For i = 1 To .Worksheets.Count 遍历文件的工作表数 arr(i + 1, j) = .Worksheets(i
7、).Name Next End With GetObject(myPath myFile).Close 关闭 End If myFile = Dir Loop Application.ScreenUpdating = True 自动计算 Range(“A1“).Resize(i, j) = arr 输出 End Sub 复制代码方法三：OpenSchema 方法思路：遍历路径下的工作簿并使用 ADO 访问文件，再用 OpenSchema 获取工作表名PS：使用 ADO 查询大量工作簿速度较快，但 ADO 对字段、数据类型等要求较严格，而且 ADO 取得的工作表名与工作表真实的排序没有关系 Op
8、enSchema 方法从提供者获取数据库模式信息。语法 Set recordset = connection.OpenSchema (QueryType, Criteria, SchemaID)querytype 所要运行的模式查询类型 Set recordset = connection.OpenSchema (adSchemaTables) 创建数据表记录集 Sub OpenSchema 法() Dim arr, n, i, j, s$ Dim myPath$, myFile$ Dim cnn As Object, rs As Object myPath = ThisWorkbook.Pa
9、th “ myFile = Dir(myPath “*.xls“) n = CreateObject(“Scripting.FileSystemObject“).GetFolder(myPath).Files.Count - 1 计算文件个数，减 1 不包括自身 ReDim arr(1 To 1000, 1 To n) 定义 arr,最大工作表数 1000 Do While myFile “ If myFile ThisWorkbook.Name Then 不等于本工作簿执行 j = j + 1 i = 1 arr(1, j) = Left(myFile, InStrRev(myFile, “
10、.“) - 1) 去后辍 Set cnn = CreateObject(“ADODB.Connection“) cnn.Open “Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=“ myPath myFile Set rs = cnn.OpenSchema(20) Set rs = cnn.OpenSchema(adSchemaTables)，创建数据表记录集 Do Until rs.EOF If rs.Fields(“TABLE_TYPE“) = “TABLE“ Then i = i
11、+ 1 s = Replace(rs(“TABLE_NAME“).Value, “, “) 去除“(数字工作表） If Right(s, 1) = “$“ Then arr(i, j) = Left(s, Len(s) - 1) 去除$号 End If rs.MoveNext Loop End If myFile = Dir Loop rs.Close cnn.Close Set rs = Nothing Set cnn = Nothing Range(“A1“).Resize(i, j) = arr 输出 End Sub 复制代码方法四：ADOX.Catalog 方法思路：遍历路径下的工作簿
12、调用的是 ADOX.Catalog 组件访问文件，再遍历对象 Table 获取工作表名 For Each MyTable In TablesADOX.CatalogMicrosoft? ActiveX? Data Objects Extensions for Data Definition Language and Security (ADOX) 是对 ADO 对象和编程模型的扩展。ADOX 包括用于模式创建和修改的对象，以及安全性。由于它是基于对象实现模式操作，所以用户可以编写对各种数据源都能有效运行的代码，而与它们原始语法中的差异无关。Sub ADOX 法() Dim cat As Obj
13、ect, MyTable As Object Dim n, i, j, s$ Dim myPath$, myFile$ myPath = ThisWorkbook.Path “ myFile = Dir(myPath “*.xls“) n = CreateObject(“Scripting.FileSystemObject“).GetFolder(myPath).Files.Count - 1 计算文件个数，减 1 不包括自身 ReDim arr(1 To 1000, 1 To n) Do While myFile “ If myFile ThisWorkbook.Name Then 不等于本
14、工作簿执行 j = j + 1 i = 1 arr(1, j) = Left(myFile, InStrRev(myFile, “.“) - 1) 去后辍 Set cat = CreateObject(“ADOX.Catalog“) cat.ActiveConnection = “Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=“ myPath myFile For Each MyTable In cat.Tables If MyTable.Type = “TABLE“ Then s = Replace(MyTable.Name, “, “) If Right(s, 1) = “$“ Then i = i + 1 arr(i, j) = Left(s, Len(s) - 1) End If End If Next End If myFile = Dir Loop Set cat = Nothing Set MyTable = Nothing Range(“A1“).Resize(i, j) = arr 输出 End Sub
