Question

我有VBA代码，应该读取我在单元格A1中键入的驱动器或文件夹的空闲和已用空间。

免费和已用空间应出现在第2行的单元格中。

Sub DriveSizes()

    Dim Drv As Drive
    Dim fs As New FileSystemObject
    Dim Letter As String
    Dim Total As Variant
    Dim Free As Variant
    Dim FreePercent As Variant
    Dim TotalPercent As Variant
    Dim i As Integer

    On Error Resume Next
    i = 2
    For Each Drv In fs.drives
        If Drv.IsReady Then
            Letter = Drv.DriveLetter
            Total = Drv.TotalSize
            Free = Drv.FreeSpace
            FreePercent = Free / Total
            TotalPercent = 1 - FreePercent
            Cells(i, 1).Value = Letter
            Cells(i, 2).Value = FreePercent
            Cells(i, 3).Value = TotalPercent
            Cells(i, 4).Value = Free
            Cells(i, 5).Value = Total
            i = i + 1
        End If
    Next

End Sub

Answer 1

您的代码几乎可以正常工作 - 您需要在VBA编辑器中设置对“Microsoft Scripting Runtime”的引用。单击工具〜参考... 并勾选“Microsoft Scripting Runtime”框。

您的代码将以字节为单位列出所有驱动器的大小，但不会列出任何文件夹。

下面的代码不需要您设置引用，您应该在Sheet1的单元格A1中输入文件夹路径。它也不会列出主文件夹中的任何单个子文件夹。

Sub DriveSizes()

    Dim Drv As Object
    Dim Fld As Object
    Dim fs As Object
    Dim DrvPath As String

    Dim Letter As String
    Dim Total As Double
    Dim Free As Double
    Dim FreePercent As Double
    Dim TotalPercent As Double
    Dim i As Integer

    On Error GoTo ErrorHandler

    With ThisWorkbook.Worksheets("Sheet1") 'Update sheet name to suit.

        DrvPath = .Cells(1, 1)
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set Drv = fs.GetDrive(fs.GetDriveName(DrvPath))
        Set Fld = fs.GetFolder(DrvPath)

        If Drv.IsReady Then
            Letter = Drv.DriveLetter
            Total = Drv.TotalSize
            Free = Drv.FreeSpace
            FreePercent = Free / Total
            TotalPercent = 1 - FreePercent
            .Cells(2, 1).Value = Letter
            .Cells(2, 2).Value = "Free Percent: " & Format(FreePercent, "0.00%")
            .Cells(2, 3).Value = "Remaining Percent: " & Format(TotalPercent, "0.00%")
            .Cells(2, 4).Value = "Free Space: " & FormatNumber(Free / 1024, 0)
            .Cells(2, 5).Value = "Total Size: " & FormatNumber(Total / 1024, 0)

            .Cells(3, 1).Value = Fld.Name
            .Cells(3, 5).Value = "Size: " & FormatNumber(Fld.Size, 0) & " bytes."
        End If

    End With

    On Error GoTo 0

Exit Sub

ErrorHandler:
    Select Case Err.Number
        Case 76 'Path not found.
            MsgBox "That file path does not exist." & vbCr & _
                   "Please check the folder exists and you have entered the correct path.", vbCritical + vbOKOnly
            Err.Clear
        Case Else
            MsgBox Err.Number & vbCr & Err.Description, vbCritical + vbOKOnly
            Err.Clear
    End Select

End Sub

代码VBA优于使用的阅读空间和免费

1 个答案: