Another WMI Disk Query in VBA

So in the preparation on the WinForms/WebBrowser blog entry I investigated some WMI code and found a VBS script that did a lot of querying of disks. I refactored the code because I wanted to understand it and also write the disk details to a block of cells.

Here is the code.

Option Explicit

Private moWMIService As Object
Private mvCells() As Variant
Private mlPass As Long
Private mlRowCount As Long

'IterateDisk
Private mlCurrentDriveIndex As Long
Private msCurrentDriveInterfaceType As String
Private msCurrentDriveCaption As String
Private mvCurrentDriveSize As Variant

Private mvCurrentPartitionNumber As Variant
Private msCurrentActive As String '* same as bootable
Private msCurrentPrimary As String

Private Enum coColumnOrdinals
    coDriveIndex
    coDriveInterfaceType
    coDriveCaption
    coDriveSize
    
    coPartitionNumber
    coActive
    coPrimary

    coLogicalDiskDeviceId
    coLogicalDiskFileSystem
    coLogicalDiskSize
    coLogicalDiskFreeSpace
    coLogicalDiskVolumeName
    

    coFirst = coDriveIndex
    coLast = coLogicalDiskVolumeName
    coCount = coLast - coFirst + 1
End Enum


Sub Test()

    Set moWMIService = GetObject("winmgmts:\\.\root\cimv2")
    
    Dim cDiskDrives As Object
    Set cDiskDrives = moWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive")
    
    Erase mvCells
    
    For mlPass = 0 To 1
        mlRowCount = 0
        IterateDisks cDiskDrives
        
        If mlPass = 0 Then
        If mlRowCount > 0 Then ReDim mvCells(1 To mlRowCount, coFirst To coLast)
        End If
    Next mlPass
    
    Dim vColHeadings As Variant
    vColHeadings = Array1dto2d(Array("DeviceId", "Interface Type", "DeviceDesc", _
            "DeviceSize", "Partition", "Bootable", "Primary", "DriveLetter", _
            "FileSystem", "PartitionSize", "PartitionFreeSpace", "VolumeName"))
    shDrives.Cells(1, 1).Resize(1, coCount).Value = vColHeadings
    shDrives.Cells(2, 1).Resize(mlRowCount, coCount).Value = mvCells
End Sub

Function Array1dto2d(v) As Variant
    Array1dto2d = Application.Transpose(Application.Transpose(v))
End Function

Sub IterateDisks(ByVal cDiskDrives As Object)
    Dim oDrive As Object
    
    Dim dicSort As Scripting.Dictionary
    Set dicSort = New Scripting.Dictionary
    
    For Each oDrive In cDiskDrives
        Debug.Assert IsNumeric(oDrive.Index)
        dicSort.Add CInt(oDrive.Index), oDrive
    Next
    
    Dim lDriveLoop As Long
    For lDriveLoop = 0 To dicSort.Count - 1
        Set oDrive = dicSort.Item(lDriveLoop)
        IterateDisk oDrive
    Next lDriveLoop
End Sub


Sub IterateDisk(ByVal oDrive As Object)

    mlCurrentDriveIndex = oDrive.Index
    msCurrentDriveInterfaceType = oDrive.InterfaceType
    msCurrentDriveCaption = oDrive.Caption
    mvCurrentDriveSize = oDrive.Size
 
    Dim cPartitions As Object
    Set cPartitions = moWMIService.ExecQuery( _
        "ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" _
        & Replace(oDrive.DeviceID, "\", "\\") & """} WHERE AssocClass = " & _
        "Win32_DiskDriveToDiskPartition")
 
 
    IteratePartitions cPartitions

End Sub

Sub IteratePartitions(ByVal cPartitions As Object)
    Dim oPartition As Object

    
    For Each oPartition In cPartitions
        IteratePartition oPartition

    Next
End Sub

Sub IteratePartition(ByVal oPartition As Object)
    
    mvCurrentPartitionNumber = Split(oPartition.DeviceID)(3)
    
    msCurrentActive = VBA.IIf(oPartition.Bootable, "Yes", "No")
    
    msCurrentPrimary = VBA.IIf(oPartition.PrimaryPartition, "Yes", "No")
    
    IterateLogicalDisks oPartition.DeviceID

End Sub

Sub IterateLogicalDisks(ByVal sPartition_DeviceID As String)
    
    Dim cLogicalDisks As Object
    Set cLogicalDisks = moWMIService.ExecQuery _
        ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & sPartition_DeviceID _
        & """} WHERE AssocClass = Win32_LogicalDiskToPartition")
    
    If cLogicalDisks.Count > 0 Then
        ReDim v(1 To cLogicalDisks.Count, 1 To 5)
    End If
    
    Dim oLogicalDisk As Object
    For Each oLogicalDisk In cLogicalDisks
        mlRowCount = mlRowCount + 1
        IterateLogicalDisk oLogicalDisk
    Next

End Sub

Sub IterateLogicalDisk(oLogicalDisk As Object)
    With oLogicalDisk
        
        If mlPass = 1 Then
            
            mvCells(mlRowCount, coDriveIndex) = mlCurrentDriveIndex
            mvCells(mlRowCount, coDriveInterfaceType) = msCurrentDriveInterfaceType
            mvCells(mlRowCount, coDriveCaption) = msCurrentDriveCaption
            mvCells(mlRowCount, coDriveSize) = Format3(mvCurrentDriveSize)

            mvCells(mlRowCount, coPartitionNumber) = mvCurrentPartitionNumber
            mvCells(mlRowCount, coActive) = msCurrentActive
            mvCells(mlRowCount, coPrimary) = msCurrentPrimary
        
            mvCells(mlRowCount, coLogicalDiskDeviceId) = oLogicalDisk.DeviceID
            mvCells(mlRowCount, coLogicalDiskFileSystem) = oLogicalDisk.FileSystem
            mvCells(mlRowCount, coLogicalDiskSize) = Format3(.Size)
            mvCells(mlRowCount, coLogicalDiskFreeSpace) = Format3(.FreeSpace)
            mvCells(mlRowCount, coLogicalDiskVolumeName) = oLogicalDisk.VolumeName
            
        End If
        
    End With


End Sub

Function Format3(n)
    Format3 = Format(n / 1000000, "#,###") ' 0, -1, 0, -1)
End Function