DriveMappingScript.vbs

DriveMappingScript.vbs

OPTION EXPLICIT
ForceScriptEngine("cscript")
Const ForAppending = 8
Dim fso, WSHNetwork, strComputer, CScolItems, objItem, strCompDom, strComputerDomain, strLogPath, strFileDate, objTextFile, objWMIService, colDriveType, objDrive
Set fso = CreateObject("Scripting.FileSystemObject")
Set WSHNetwork = CreateObject("WScript.Network")
strComputer = WSHNetwork.ComputerName
Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
Set CScolItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")
For Each objItem in CScolItems
strCompDom = Ucase(objItem.Domain) 'MAKE DOMAIN TEXT UPPERCASE
strComputerDomain = Left(strCompDom, 5) 'CHOP THE .domain.co.uk BIT OFF - you'll need to change "5" for the length of the NETBIOS name of your domain
'e.g. if my fully qualified domain name is DOMAINA.domain.co.uk then use: Left(strCompDom, 7)
Next
'SETUP SOME FILE/LOGGING PROPERTIES
strLogPath = "\\Servername\PathToLoggingDirectory\"
strFileDate = Replace(FormatDateTime(Date(),2),"/","-")
'CREATE TEXT FILE SYSTEM OBJECT
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = fso.OpenTextFile(strLogPath & "MAPPEDDRIVES" & ".txt",8,True)
'DO THE LOOKUP AND WRITE THE FILE OUT..
If (strComputer <> "") Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colDriveType = objWMIService.ExecQuery("Select * from Win32_MappedLogicalDisk")
For Each objDrive in colDriveType
objTextFile.WriteLine strFileDate & "," & strComputer & "," & strComputerDomain & "," & objDrive.Caption & "," & objDrive.ProviderName
Next
End If
objTextFile.Close
'TIDY UP
Set fso = Nothing
Set WSHNetwork = Nothing
Set strComputer = Nothing
Set strLogPath = Nothing
Set strFileDate = Nothing
Set objTextFile = Nothing
Set objWMIService = Nothing
Set colDriveType = Nothing
Set objDrive = Nothing
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub ForceScriptEngine(strScriptEng)
' Forces this script to be run under the desired scripting host.
' Valid arguments are "wscript" or "cscript".
' The command line arguments are passed on to the new call.
Dim arrArgs
Dim strArgs
For Each arrArgs In WScript.Arguments
strArgs = strArgs & " " & Chr(34) & arrArgs & Chr(34)
Next
If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "cscript.exe //Nologo " & _
Chr(34) & Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
Else
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & _
Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
End If
End Sub