VBA文件管理器.xlsm(文件读取)

【实例简介】

【实例截图】

Sub GetFileProperties()
    On Error GoTo ErrorHandler
    Dim fd As FileDialog
    Dim fso As Object
    Dim file As Object
    Dim selectedItem As Variant
    Dim ws As Worksheet
    Dim rowIndex As Long
    Dim attributes As Integer
    Dim lastRow As Long
    
    ' 设置错误处理
    Set ws = ActiveSheet
    
    ' 清空原有数据（保留标题行）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow > 1 Then
        ws.Range("A2:J" & lastRow).ClearContents
    End If
    
    ' 创建文件选择对话框
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "选择文件"
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "所有文件", "*.*"
        
        ' 检查用户选择
        If .Show <> -1 Then
            MsgBox "操作已取消，未选择文件。", vbInformation, "取消操作"
            Exit Sub
        End If
        
        ' 初始化文件系统对象
        Set fso = CreateObject("Scripting.FileSystemObject")
        rowIndex = 2  ' 从第二行开始输出
        
        ' 设置标题行
        ws.Range("A1:J1").Value = Array("文件名", "路径", "文件扩展名", "类型描述", "大小(KB)", _
                                        "创建日期", "修改日期", "最后访问时间", "是否为只读", "是否为隐藏")
        
        ' 遍历所有选中的文件
        For Each selectedItem In .SelectedItems
            Set file = fso.GetFile(selectedItem)
            attributes = file.attributes
            
            ' 输出文件属性
            With ws
                .Cells(rowIndex, 1).Value = file.Name                          ' 文件名
                .Cells(rowIndex, 2).Value = file.Path                          ' 路径
                .Cells(rowIndex, 3).Value = fso.GetExtensionName(file.Path)    ' 扩展名
                .Cells(rowIndex, 4).Value = file.Type                          ' 类型描述
                .Cells(rowIndex, 5).Value = Round(file.Size / 1024, 2)         ' 大小(KB)
                
                ' 安全处理日期格式
                .Cells(rowIndex, 6).Value = Format(file.DateCreated, vbGeneralDate)
                .Cells(rowIndex, 7).Value = Format(file.DateLastModified, vbGeneralDate)
                .Cells(rowIndex, 8).Value = Format(file.DateLastAccessed, vbGeneralDate)
                
                ' 属性检查
                .Cells(rowIndex, 9).Value = IIf((attributes And 1) = 1, "是", "否")  ' 只读
                .Cells(rowIndex, 10).Value = IIf((attributes And 2) = 2, "是", "否") ' 隐藏
            End With
            
            rowIndex = rowIndex 1
        Next selectedItem
        
        MsgBox "成功导入 " & .SelectedItems.Count & " 个文件的属性", vbInformation, "操作完成"
    End With

CleanExit:
    ' 清理对象
    Set file = Nothing
    Set fso = Nothing
    Set fd = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "错误 " & Err.Number & ": " & Err.Description & vbCrLf & _
           "发生在 " & Erl, vbCritical, "系统错误"
    Resume CleanExit
End Sub