[已解决]能否用VBA实现提取磁盘容量的功能，谢谢爱疯老师！

lhj323323

老师端午节快乐！

我想实现如下效果：
1、本模板所在的电脑（指台式电脑）的硬盘内一共有几个区（不包含光盘驱动器）；
2、每个区的【已用空间】和【可用空间】
3、通过EXCEL的VBA程序把上述信息导入到sheet2工作表中

先谢谢各位老师了，（没有上传EXCEL模板）

我需要的效果是这样：

最佳答案

月排行榜 / 总排行榜

爱疯

2016-6-9 08:54

Sub test()
    Dim fso As Object, dri As Object
    Dim i As Integer

    Range("a1").CurrentRegion.Clear
    i = 1
    Cells(i, 1).Resize(1, 3) = Array("盘符", "已用空间", "容量")
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each dri In fso.Drives
        If dri.IsReady Then
            i = i + 1
            Cells(i, 1) = dri.DriveLetter    '盘符
            Cells(i, 2) = Format((dri.TotalSize - dri.AvailableSpace) / 1024 ^ 3, "0.0G")    '已用空间
            Cells(i, 3) = Format(dri.TotalSize / 1024 ^ 3, "0G")    '容量
        End If
    Next
End Sub

跳转到最佳答案楼层

lhj323323

这是我在本论坛搜索到的不解木野狐老师的语句

Sub 磁盘信息()
    Dim 盘符 As String, 类型 As String
    For i = 1 To 26
        On Error Resume Next
        盘符 = Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", i, 1)
        Select Case CreateObject("Scripting.FileSystemObject").GetDrive(盘符 & ":").DriveType
        Case 0: 类型 = "无法识别"
        Case 1: 类型 = "移动磁盘"
        Case 2: 类型 = "固定磁盘"
        Case 3: 类型 = "网络磁盘"
        Case 4: 类型 = "光盘DVD"
        Case 5: 类型 = "虚拟磁盘"
        End Select
        If Err.Number <> 68 Then
            msg = msg & CreateObject("Scripting.FileSystemObject").GetDrive(盘符 & ":").DriveLetter & "   " & 类型 & "   " & CreateObject("Scripting.FileSystemObject").GetDrive(盘符 & ":").SerialNumber & "   " & CreateObject("Scripting.FileSystemObject").GetDrive(盘符 & ":").TotalSize / 1024 & "   " & CreateObject("Scripting.FileSystemObject").GetDrive(盘符 & ":").FreeSpace / 1024 & Chr(10)
        End If
    Next i
    MsgBox msg
End Sub

但显示的各磁盘的容量与实际并不相符

请看附图

爱疯

Sub test()
    Dim fso As Object, dri As Object
    Dim i As Integer

    Range("a1").CurrentRegion.Clear
    i = 1
    Cells(i, 1).Resize(1, 3) = Array("盘符", "已用空间", "容量")
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each dri In fso.Drives
        If dri.IsReady Then
            i = i + 1
            Cells(i, 1) = dri.DriveLetter    '盘符
            Cells(i, 2) = Format((dri.TotalSize - dri.AvailableSpace) / 1024 ^ 3, "0.0G")    '已用空间
            Cells(i, 3) = Format(dri.TotalSize / 1024 ^ 3, "0G")    '容量
        End If
    Next
End Sub

lhj323323

爱疯 发表于 2016-6-9 08:54
Sub test()
    Dim fso As Object, dri As Object
    Dim i As Integer

谢谢爱疯老师！

今天研究这个东西一整天了，还是入不了门。