需求：调整VBA宏实现遍历文件夹工作簿并统计工作表数量

没问题，我帮你把这个VBA代码补全并优化了，刚好能完美实现你要的功能——遍历指定文件夹里的所有Excel工作簿，统计每个文件的工作表数量，然后把文件名和对应数量写到新建的工作表里。

先给你完整的可直接运行的代码：

Sub ListAllFile()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim targetWB As Workbook
    Dim lastRow As Long
    Dim folderPath As String
    
    ' 创建文件系统对象，用来操作文件夹和文件
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' 弹出对话框让你选择要统计的文件夹，比硬写路径灵活多了
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择要统计的文件夹"
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "未选择文件夹，程序退出。"
            Exit Sub
        End If
    End With
    
    ' 新建一个工作表用来放统计结果
    Set ws = Worksheets.Add
    ' 先设置表头，看着更清晰
    ws.Range("A1").Value = "工作簿文件名"
    ws.Range("B1").Value = "工作表数量"
    lastRow = 2 ' 从第2行开始写数据，留第1行当表头
    
    ' 获取你选中的文件夹对象
    Set objFolder = objFSO.GetFolder(folderPath)
    
    ' 挨个遍历文件夹里的所有文件
    For Each objFile In objFolder.Files
        ' 只处理Excel格式的文件，避免乱处理其他文档
        Select Case LCase(objFSO.GetExtensionName(objFile.Name))
            Case "xls", "xlsx", "xlsm", "xlsb"
                ' 加个错误捕获，防止遇到损坏/加密的文件导致程序崩溃
                On Error Resume Next
                ' 只读打开文件，不会修改原文件，也减少占用冲突
                Set targetWB = Workbooks.Open(objFile.Path, ReadOnly:=True)
                If Err.Number = 0 Then
                    ' 写入文件名和对应的工作表数量
                    ws.Range("A" & lastRow).Value = objFile.Name
                    ws.Range("B" & lastRow).Value = targetWB.Sheets.Count
                    targetWB.Close SaveChanges:=False ' 只读打开，不用保存直接关
                    lastRow = lastRow + 1 ' 准备写下一个文件的数据
                Else
                    ' 要是文件打不开，就标记出来，方便你排查
                    ws.Range("A" & lastRow).Value = objFile.Name & " (打开失败)"
                    ws.Range("B" & lastRow).Value = "N/A"
                    lastRow = lastRow + 1
                    Err.Clear ' 清除错误，继续处理下一个文件
                End If
                On Error GoTo 0 ' 恢复正常的错误处理机制
        End Select
    Next objFile
    
    ' 自动调整列宽，让结果看起来更整齐
    ws.Columns("A:B").AutoFit
    
    MsgBox "统计完成！结果已经写入新建的工作表啦~"
End Sub

代码关键细节说明（怕你看不懂，给你拆解下）： #

• 可视化选文件夹：用对话框让你手动选文件夹，不用硬改代码里的路径，换文件夹的时候直接选就行；
• 筛选Excel文件：只处理常见的Excel格式（xls/xlsx/xlsm/xlsb），不会去碰Word、PDF这些非目标文件；
• 错误防护：遇到损坏、加密或者正在被占用的文件时，程序不会崩溃，还会给你标记出哪个文件打不开；
• 只读打开：打开原工作簿时用只读模式，不会不小心修改到原文件，也能减少文件被占用的问题；
• 自动美化：最后自动调整列宽，不用你手动拉列宽。

使用步骤： #

1. 打开Excel，按下Alt + F11打开VBA编辑器；
2. 右键点击左侧的「VBAProject」，选择「插入」→「模块」；
3. 把上面的代码粘贴到模块里；
4. 按下F5运行代码，跟着提示选要统计的文件夹就搞定啦！

内容的提问来源于stack exchange，提问作者NormX