不打开工作簿，统计各工作簿的表单个数

小NN

不打开工作簿，统计各工作簿的表单（sheet）数量。

不要修改被统计的工作簿内容，统计完后弹窗提示。

likaiyihou

可使用GETOBJECT函数

hongshan2019

现在百度也挺有意思，都是AI

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf() '//2024.3.15
   
2.     Set Fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     p = ThisWorkbook.Path & "\文件夹"
   
6.     ReDim brr(1 To 1000, 1 To 2)
   
7.     For Each f In Fso.GetFolder(p).Files
   
8.         If f.Name Like "*.xls*" Then
   
9.             fn = Fso.GetBaseName(f)
   
10.             m = m + 1
    
11.             Set wb = Workbooks.Open(f, 0)
    
12.             brr(m, 1) = fn
    
13.             brr(m, 2) = wb.Sheets.Count
    
14.             wb.Close False
    
15.         End If
    
16.     Next f
    
17.     On Error Resume Next
    
18.     sh.[a2:b1000] = ""
    
19.     sh.[a2].Resize(m, 2) = brr
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    

复制代码

limonet

关键字：catalog

limonet

Sub limonet()
    Dim Cat As Object, ObjTable As Object, Path$, FileName$, Arr() As Variant, i%
    Set Cat = CreateObject("ADOX.Catalog")
    Path = ThisWorkbook.Path & "\文件夹\"
    FileName = Dir(Path & "*.xls?")
    Do While FileName <> ""
        j = j + 1: i = 0
        Cat.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & Path & FileName
        For Each ObjTable In Cat.Tables
            If Not ObjTable.Name Like "*FilterDatabase" And ObjTable.Type = "TABLE" Then i = i + 1
        Next ObjTable
        ReDim Preserve Arr(1 To 2, 1 To j): Arr(1, j) = FileName: Arr(2, j) = i
        FileName = Dir
    Loop
    Range("A2").Resize(UBound(Arr, 2), 2) = Application.Transpose(Arr)
End Sub