怎样提取文件相关参数信息

SCWYZJ

求助：怎样提取文件相关参数信息（见附件），请各位大神帮忙看看，谢谢！

蓝桥玄霜

文件的属性的例子：

网海遨游

你参考下:

Sub 工作薄相关信息() '工作薄多时,可以套个Do循环
    Application.ScreenUpdating = False
    strFilename = ThisWorkbook.Path & "\122.xlsm"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objfile = fso.GetFile(strFilename)
    If fso.fileexists(strFilename) Then
        sReturn = "        文件相关参数信息" & Chr(10)
        sReturn = sReturn & "文件名： " & Dir(strFilename) & Chr(10)
        sReturn = sReturn & "文件创建日期： " & objfile.DateCreated & Chr(10)
        sReturn = sReturn & "文件修改日期： " & objfile.DateLastModified & Chr(10)
        sReturn = sReturn & "文件最后访问日期： " & objfile.datelastaccessed & Chr(10)
        sReturn = sReturn & "文件大小 " & FormatNumber(objfile.Size / 1024, -1)
        sReturn = sReturn & "Kb" & Chr(10)
        sReturn = sReturn & "文件类型： " & objfile.Type & Chr(10)
        MsgBox sReturn '用对话框显示相关信息
    Else
        MsgBox strFilename & "文件不存在!"
    End If
    Application.ScreenUpdating = True
End Sub

excel海

Sub Test()
    Dim i, j, k, arr, brr, x, y
    Dim fs, fd, f, strPath
    Set fs = CreateObject("scripting.filesystemobject")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    If fd.Show = -1 Then
        strPath = fd.SelectedItems(1)
    Else
        Exit Sub
    End If
    ReDim arr(1 To 1, 1 To 7)
    Set f = fs.getfile(strPath)
    With Sheet1
        x = .Cells(Rows.Count, 1).End(xlUp).Row
        arr(1, 1) = x - 1
        arr(1, 2) = fs.GetBaseName(strPath)
        arr(1, 3) = Replace(fs.getfilename(strPath), arr(1, 2) & ".", "")
        arr(1, 4) = f.Size
        arr(1, 5) = f.DateCreated
        arr(1, 6) = f.DateLastModified
        arr(1, 7) = f.DateLastAccessed
        .Cells(x + 1, 1).Resize(1, UBound(arr, 2)) = arr
    End With
End Sub

excel海

Sub Test()
    Dim i, j, k, arr, brr, x, y
    Dim fs, fd, f, strPath
    Set fs = CreateObject("scripting.filesystemobject")
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    If fd.Show = -1 Then
        strPath = fd.SelectedItems(1)
    Else
        Exit Sub
    End If
    ReDim arr(1 To 1, 1 To 7)
    Set f = fs.getfile(strPath)
    With Sheet1
        x = .Cells(Rows.Count, 1).End(xlUp).Row
        arr(1, 1) = x - 1
        arr(1, 2) = fs.GetBaseName(strPath)
        arr(1, 3) = Replace(fs.getfilename(strPath), arr(1, 2) & ".", "")
        arr(1, 4) = f.Size
        arr(1, 5) = f.DateCreated
        arr(1, 6) = f.DateLastModified
        arr(1, 7) = f.DateLastAccessed
        .Cells(x + 1, 1).Resize(1, UBound(arr, 2)) = arr
    End With
End Sub

SCWYZJ

2-5楼的各位老师，我都试了下，比较接近我的要求，就是文件大小哪里，怎样自动计算后带上KB,MB,GB单位呢？

excel海

大小是kb的,你用&"kb"l连接就是,MB,GB换算下

SCWYZJ

可否帮我写下那段换算代码，谢谢