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