Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.