Monday, 20 March 2017

Using WMI this time to query disk drive information (plus Shell with ComSpec)

Another example of using WMI this time to query disk drive information, here we show the equivalent of running a command line vol.
This code also demonstrates shelling using the command spec see SO answer.

Option Explicit

'**********************************************************************************
'* Entry Point
'**********************************************************************************
Sub Main2()

    Debug.Assert Replace(VSNByCommandLine, "-", "") = VSNByWMI

End Sub

'**********************************************************************************
'* Volume Serial Number by WMI
'**********************************************************************************
Function VSNByWMI() As String
    Dim sSysDrive As String
    sSysDrive = Environ("SystemDrive")
    
    Dim sComputer As String
    sComputer = "."
    Dim objWMIService
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
            & sComputer & "\root\cimv2")
    
    Debug.Assert TypeName(objWMIService) = "SWbemServicesEx"
    

    Dim colDisks
    Set colDisks = objWMIService.ExecQuery _
        ("Select * from Win32_LogicalDisk where deviceid='" & sSysDrive & "'")
        
    Debug.Assert colDisks.Count = 1
    
    Dim sVolumeSerialNumber As String
    
    Dim objDisk
    For Each objDisk In colDisks
        sVolumeSerialNumber = objDisk.VolumeSerialNumber
    Next
    VSNByWMI = sVolumeSerialNumber
End Function

'**********************************************************************************
'* Volume Serial Number by Shelling to a command line andf running 'vol c:'
'**********************************************************************************
Function VSNByCommandLine() As String

    Dim sSysDrive As String
    sSysDrive = Environ("SystemDrive")    
    Dim sCmdSpec As String
    sCmdSpec = Environ("comspec")
    VBA.Shell sCmdSpec & " /C vol " & sSysDrive & " > C:\temp\vol.txt"
    
    Dim fso As Scripting.FileSystemObject
    Set fso = CreateObject("Scripting.filesystemobject")
    Debug.Assert fso.fileExists("c:\temp\vol.txt")
    
    Dim vVolPiped
    vVolPiped = Split(fso.OpenTextFile("c:\temp\vol.txt").readall)
    
    Dim sVol As String
    sVol = Replace(vVolPiped(UBound(vVolPiped)), vbNewLine, vbNullString)

    VSNByCommandLine = sVol
End Function


No comments:

Post a Comment