用VBA提取路径下所有工作簿的工作表名(四个方法).doc

用VBA提取路径下所有工作簿的工作表名（四个方法） 方法一：Open方法思路：遍历路径下的工作簿并用Workbooks.Open打开，再遍历工作表名Workbooks.Open打开一个工作簿。语法表达式.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)表达式 一个代表 Workbooks 对象的变量。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(Scripting.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 遍历工作表 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 对象的引用。语法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 计算文件个数，减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).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取得的工作表名与工作表真实的排序没有关系OpenSchema 方法从提供者获取数据库模式信息。语法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.Path & 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, .) - 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 + 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 方法思路：遍历路径下的工作簿调用的是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 Object, 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 不等于本工作簿执行 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 = TAB