查询某文件夹下所有EXCEL表格文件工作表行数和列数等信息

Sub CheckExcelFileINFO()
    Dim v_Path, v_FileName, v_currentWbName
    Dim v_Wbook As Workbook
    Dim v_FName2 As String
    Dim i As Long       '变量
    Dim j As Long
    Dim n As Long       '文件计数变量
    Dim v_Rows As Long  '行数
    Dim v_Cols As Long  '列数
    
    Application.ScreenUpdating = False   '暂停刷新
    'Application.DisplayAlerts = False '使不弹出询问 是否替换目标单元格内容
    'v_Path = ActiveWorkbook.Path   '当前目录
    
    Dim v_FileDialog As FileDialog
    Set v_FileDialog = Application.FileDialog(msoFileDialogFolderPicker)  '选择目录
    
    'Application.FileDialog 的参数说明：
    'msoFileDialogOpen         打开旧文件
    'msoFileDialogSaveAs       保存文件
    'msoFileDialogFilePicker   选择文件
    'msoFileDialogFolderPicker 选择目录
    
    v_FileDialog.Title = "选择文件夹"      '窗口标题
    v_FileDialog.InitialFileName = "E:\"    '设置默认目录
    'v_FileDialog.AllowMultiSelect = True  '可复选多个文件
    'v_FileDialog.Filters.Clear
    'v_FileDialog.Filters.Add "Excel文件", "*.xlsx"   '文件类型
    'v_FileDialog.Filters.Add "所有文件", "*.*"

    If v_FileDialog.Show = -1 Then  '“v_FileDialog.Show = -1”表示有选择
       v_Path = v_FileDialog.SelectedItems(1)
    Else
       MsgBox "没有选择文件夹", vbExclamation, "提示"
       Exit Sub   '退出
    End If
    'For Each vF In v_FileDialog.SelectedItems  '选择多个文件时
    '   MsgBox vF
    'Next vF

    '字符串截取子串函数说明：
    'Left(Text, num_chars)   '从左边开始截取num_chars个字符
    'Right(Text, num_chars)  '从侧边开始截取num_chars个字符
    'Mid(Text, Start_Num, num_chars)  '在第Start_Num位起截取num_chars个字符
    
    
    '调用Shell选择目录方式二：
    'Dim v_Shell
    'Set v_Shell = CreateObject("Shell.Application")
    'Set v_Path = v_Shell.BrowseForFolder(&O0, "选择文件夹", &H10, "E:\")
    'If v_Path Is Nothing Then '“Not v_Path Is Nothing”表示有选择
    '   MsgBox "没有选择文件夹", vbExclamation, "提示"
    '   Set v_Shell = Nothing
    '   Set v_Path = Nothing
    '   Exit Sub   '退出
    'End If
    'MsgBox v_Path.items.Item.Path

    If Right(v_Path, 1) <> "\" Then   '检查路径最后是否有“\”符
       v_Path = v_Path & "\"
    End If
    
    'Dir [(pathname, [ attributes ])]
    'Windows操作系统，Dir的attributes参数可使用通配符来指定多个文件：多字符 (*) 、单字符 (?)
    v_FileName = Dir(v_Path & "*.xls")
    v_currentWbName = ActiveWorkbook.Name

    n = 0  '计算文件数量
    Do While v_FileName <> ""   '遍历对应目录下文件
       If v_FileName <> v_currentWbName Then

          'On Error GoTo Error_Handle:  '打开文件失败时跳转
          On Error Resume Next   '打开文件遇到错误时继续往下执行
          Set v_Wbook = Workbooks.Open(Filename:=v_Path & v_FileName, ReadOnly:=True, UpdateLinks:=False) '打开文件
          'v_Wbook.Name  '文件名
          
          '取行数
          v_Rows = v_Wbook.Sheets(1).UsedRange.Cells(Sheets(1).UsedRange.Rows.Count, 1).Row
   
          '取列数
          v_Cols = v_Wbook.Sheets(1).UsedRange.Cells(1, Sheets(1).UsedRange.Columns.Count).Column
          
          
          '处理业务

          If Err.Number <> 0 Then
             v_Wbook.Close savechanges:=False  '关闭文件
             Set v_Wbook = Nothing
             
             '重试
             Set v_Wbook = Workbooks.Open(Filename:=v_Path, ReadOnly:=True, CorruptLoad:=XlCorruptLoad.xlRepairFile, UpdateLinks:=False)
             DoEvents
          End If
'Error_Handle:
          If Err.Number <> 0 Then  '出现错误时捕获 Err.Description 和 Err.Number
             v_FName2 = v_FName2 & Chr(13) & v_FileName & " （" & Err.Description & Err.Number & "）"
          Else
             v_FName2 = v_FName2 & Chr(13) & v_FileName  '记录处理文件名
          End If
          
          n = n + 1  '文件数+1
          
          With Workbooks(1).ActiveSheet
             j = .Cells(Rows.Count, 1).End(xlUp).Row   '当前表格第一列最后非空单元格行号
             If (j = 1 And Not IsEmpty(Cells(1, 1).Value)) Or j > 1 Then
                '若返回非空单元格行号为“1”，且对应列第1个单元格不为空
                '或者非空单元格行号大于“1”
                j = j + 1  '调整新行号为非空单元格行号+1
             End If
             .Cells(j, 1) = n
             .Cells(j, 2) = v_FileName
             .Cells(j, 3) = v_Rows & "行"
             .Cells(j, 4) = v_Cols & "列"
          End With
          
          v_Wbook.Close False  '关闭文件
          Set v_Wbook = Nothing

       End If
       
       v_FileName = Dir

    Loop

    Range("A1").Select   '定位至一个单元格
    Application.ScreenUpdating = True   '恢复
    MsgBox "搜索" & v_Path & "有" & n & "个工作薄：" & Chr(13) & v_FName2, vbInformation, "提示"
End Sub