用VBA提取路径下所有工作簿的工作表名

1、用 VBA 提取路径下所有工作簿的工作表名（四个方法）方法一： Open 方法思路：遍历路径下的工作簿并用 Workbooks.Open 打开，再遍历工作表名 Workbooks.Open 打 开一个工作簿。语法表达式 .Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad) 表达式 一个代表 W

2、orkbooks 对象的变量。 Sub Open 法()Dimarr Dim n&, i&, j&, s$Dim wb AsWorkbook, sht As Worksheet, wbk As WorkbookDimmyPath$, myFile$Application.ScreenUpdating = False 禁刷新 Application.Calculation = xlManual禁计算Set wbk = ThisWorkbook myPath = ThisWorkbook.Path & myFile = Dir(myPath & *.xls)

3、n =CreateObject(Scripting.FileSystemObject).GetFolder(myPath) .Files.Count - 1计算文件个数，减 1 不包括自身ReDim arr(1 To 1000, 1 To n)Do While myFile <> If myFile <> wbk.Name Thenj = j + 1i = 1arr(1, j) = Left(myFile, InStrRev(myFile, .)- 1) 去后辍 Set wb = Workbooks.Open(myPath & & myFile)打开工作

4、簿= i + 1arr(i, j) = sht.NameNextwb.CloseEnd IfmyFile =DirLoopwbk.ActiveSheet.Range(A1).Resize(i, j) =arr输出Application.Calculation = xlAutomatic刷For Each sht In wb.Sheets 遍历工作表i新 Application.ScreenUpdating = True自动计算End Sub 复制代码方法二： GetObject 方法思路：遍历路径下 的工作簿并使用 GetObject 函数访问文件， 再获取工作表名 GetObject 返回文

5、件中的 ActiveX 对象的引用。语法 GetObject(pathname , class)Sub GetObject 法 () Dim cat As Object, MyTable As ObjectDim n&, i&,j&, s$Dim myPath$,myFile$ Application.ScreenUpdating = False禁刷新myPath = ThisWorkbook.Path & myFile =Dir(myPath & *.xls)n =CreateObject(Scripting.FileSystemObject).Get

6、Folder(myPath) .Files.Count - 1计算文件个数，减 1 不包括自身ReDim arr(1 To 1000, 1 To n)Do While myFile <> If myFile <> ThisWorkbook.Name Then 不等于本工作簿执行 j = j + 1i = 1arr(1, j) = Left(myFile, InStrRev(myFile, .) - 1)去后辍With GetObject(myPath & myFile) 使用 GetObject 函For i = 1数可以访问文件NextTo .Workshee

7、ts.Count 遍历文件的工作表数arr(i + 1, j) = .Worksheets(i).NameEnd WithGetObject(myPath &myFile).Close 关闭End IfmyFile = Dir自动计Loop Application.ScreenUpdating = True算 Range(A1).Resize(i, j) = arr输出 End Sub 复制代码方法三： OpenSchema 方法思路：遍历路径下的工作簿并 使用 ADO 访问文件，再用 OpenSchema 获取工作表名 PS： 使用 ADO 查询大量工作簿速度较快， 但 ADO 对字

8、段、 数据 类型等要求较严格，而且 ADO 取得的工作表名与工作表真 实的排序没有关系 OpenSchema 方法从提供者获取数据库 模式信息。语法 Set recordset = connection.OpenSchema (QueryType, Criteria, SchemaID)querytype 所要运行的模式查 询类型 Set recordset = connection.OpenSchema(adSchemaTables)创建数据表记录集 Sub OpenSchema 法() Dim arr, n&, i&, j&, s$ Dim myPath$, myF

9、ile$ Dim cnn As Object, rs As Object myPath = ThisWorkbook.Path & myFile = Dir(myPath & *.xls) n =CreateObject(Scripting.FileSystemObject).GetFolder(myPath)ReDim arr(1 To 1000, 1 To n)定义 arr,最大工作表数 1000Do While myFile <> If myFile <>ThisWorkbook.Name Then不等于本工作簿执行j = j + 1i = 1ar

10、r(1, j) =Left(myFile, InStrRev(myFile, .) - 1)去后辍Set cnn = = cnn.OpenSchema(20) Set rs =cnn.OpenSchema(adSchemaTables，) 创建数据表记录集 Do Until rs.EOFIfrs.Fields(TABLE_TYPE) = TABLE Then i = i + 1s =Replace(rs(TABLE_NAME).Value, , )去除(数字工作表)If Right(s, 1) =$ Then arr(i, j) = Left(s, Len(s) - 1)去除 $号End If

11、rs.MoveNextLoopEnd IfmyFile = Dir Loop rs.Closecnn.Close Set rs = Nothing Set cnn = NothingRange(A1).Resize(i, j) = arr输出 End Sub 复制代码方法四： ADOX.Catalog 方法思路：遍历路径下的工作簿调用的 是 ADOX.Catalog 组件访问文件，再遍历对象 Table 获取工作表名 For Each MyTable In TablesADOX.CatalogMicrosoft? ActiveX? Data Objects Extensions for Dat

12、a Definition Language and Security (ADOX) 是对 ADO 对象和编程模型 的扩展。 ADOX 包括用于模式创建和修改的对象， 以及安全 性。由于它是基于对象实现模式操作，所以用户可以编写对 各种数据源都能有效运行的代码，而与它们原始语法中的差 异无关。 Sub ADOX 法 ()Dim cat As Object, MyTable AsObject Dim n&, i&, j&, s$ Dim myPath$, myFile$myPath = ThisWorkbook.Path & myFile = Dir(myPath

13、& *.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 不等于本工作簿执行 j = j + 1i = 1arr(1, j) = Left(myFile, InStrRev(myFile, .) - 1)去后辍Set cat = CreateObject(ADOX.Catalog) cat.ActiveConnection = If MyTable.Type = TABLE T