Public Function GetFileObject() As Object '取文件返回File对象
Dim FileName As String
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = -1 Then
.Filters.Clear
.Filters.Add "文本文件", "*.txt"
.Title = "选择文件"
FileName = .SelectedItems(1)
Else
Set GetFileObject = Nothing
Exit Function
End If
End With
Dim fs
Set fs = CreateObject("scripting.FileSystemObject")
Set GetFileObject = fs.GetFile(FileName)
Set fs = Nothing
End Function
Private Sub GetFileinfo() '提取文件信息
Set f = GetFileObject'调用提取File对象函数
If f Is Nothing Then GoTo Ex100'如果对象是Nothing退出
Dim sh As Worksheet, cell As Range, xcell As Range
Set sh = ActiveSheet
Set cell = sh.Range("C4:C15")
Dim infoArr(0 To 11), i As Integer
For i = 0 To cell.Rows.Count
Select Case i
Case 0
infoArr(0) = f.Attributes'文件属性
Case 1
infoArr(1) = f.datecreated'创建日期
Case 2
infoArr(2) = f.datelastaccessed
Case 3
infoArr(3) = f.datelastmodified
Case 4
infoArr(4) = f.drive'驱动器
Case 5
infoArr(5) = f.Name'文件名
Case 6
infoArr(6) = f.parentFolder
Case 7
infoArr(7) = f.Path'文件路径
Case 8
infoArr(8) = f.shortname
Case 9
infoArr(9) = f.shortpath
Case 10
infoArr(10) = f.Size'文件大小
Case 11
infoArr(11) = f.Type'文件类型
End Select
Next i
Set cell = cell.Item(1).Offset(0, 2).Resize(cell.Rows.Count, 1)
cell = Application.WorksheetFunction.Transpose(infoArr)
Ex100:
Set f = Nothing
End Sub