Attempting to extract printers from users machine and then outputting to a text fill. - vbscript

I am attempting to extract the printers from a users machine and then output to a text file but when I run the test I get a invalid procedure call or argument for this specific line of code.
Set objOutputFile = objFSO.OpenTextFile(outFile, ForAppending, True)
I have attempted to change OpenTextFileto CreateTextFile but I need the lines to appended to file as it will be running as a log on script.
I have done some research and used the Microsoft developer articles to help me debug the issue in the code but I don't have much experience in Visual Basic.
I have added the entire script to give context to the what is going on.
dim objComputerName, ObjNetwork , strText , objfile, StrComputer
dim wshnetwork
Set wshnetwork = CreateObject ("Wscript.network")
StrComputer = WshNetwork.ComputerName
If IsEmpty(StrComputer) Then Wscript.Quit
Set WshNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
outFile = "C:\scripts\Printers" & StrComputer
Set objOutputFile = objFSO.OpenTextFile(outFile, ForAppending, True)
For Each objPrinter in colInstalledPrinters
strTest = Left(objPrinter.Name, 2)
objOutputFile.WriteLine(objPrinter.Name)
objfile.close
Next
Set objPrinter = WshNetwork.EnumPrinterConnections
'Set objOutputFile = objFSO.OpenTextFile (filOutput, ForAppending, True)
If objPrinter.Count = 0 Then
WScript.Echo "No Printers Mapped "
else
For intDrive = 0 To (objPrinter.Count -1) Step 2
intNetLetter = IntNetLetter +1
printer = "UNC Path " & objPrinter.Item(intDrive) & " = " & objPrinter.Item(intDrive +1) & " Printer : " & intDrive
objOutputFile.WriteLine(printer)
Next
end if
objOutputFile.Close``*

Invalid procedure call or argument
You passed an invalid parameter in your procedure call. This could be because the parameter was out of range, or contained invalid data. Alternately, you may have invoked a procedure at an unexpected time.
To correct this error
Verify that the parameters being passed to the procedure are valid.
Verify that you are calling the function at an appropriate time.
My guess is this line is an ilegal filename.
outFile = "C:\scripts\Printers" & StrComputer
On my computer this is c:\scripts\PrintersSerenity which is probably not right that your text file is called PrintersSerenity without an extension.

Related

VBScript errors with GetObject call

The goal is to retrieve the Dell service tags of all systems in a list (pseudo-systems given below in place of real system names)
The following script was originally used, and works just fine.
On Error Resume Next
strComputer=InputBox ("Enter the computer name of the server you'd like to query for Service Tag")
Set objWMIservice = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
WScript.Echo "Error: " & Err.number
Set colitems = objWMIservice.ExecQuery("Select SerialNumber from Win32_BIOS", , 48)
For Each objitem In colitems
WScript.Echo "Dell Service Tag: " & objitem.SerialNumber
Next
It asks for the user to input the system name, and then retrieves the tag.
However, there are 200+ systems to run, and it'd be nice to avoid having to type them all in manually.
My attempt to do just that (below) is close to right, but fails with error 70 codes on systems that the first script finds just fine.
On Error Resume Next
Dim systems, splitSystems, objWMIservice, fso, output, tag, mystr
systems = "sys1,sys2,sys3,sys4"
splitSystems = Split(systems,",")
Set fso = CreateObject("Scripting.FileSystemObject")
Set output = fso.CreateTextFile("system_tags.csv", True)
output.WriteLine """System Name"",""Service Tag"""
For Each sys In splitSystems
If Ping(sys) = True Then
'Doesn't work
mystr = "winmgmts:\\" & sys & "\root\cimv2"
Set objWMIservice = GetObject(mystr)
'Also doesn't work
'Set objWMIservice = GetObject("winmgmts:\\" & sys & "\root\cimv2")
'Works just dandy
'Set objWMIservice = GetObject("winmgmts:\\sys1\root\cimv2")
If Err.number <> 0 Then
'output.WriteLine """" & sys & """,""ERROR """ & Err.number
WScript.Echo "Set objWMIservice = GetObject('" & mystr & "') failed from Err.code:" & Err.description
Else
For Each objitem In objWMIservice.ExecQuery("Select SerialNumber from Win32_BIOS",,48)
tag = objitem.SerialNumber
Next
output.WriteLine """" & sys & """,""" & tag & """"
End If
Else
output.WriteLine """" & sys & """,""OFFLINE"""
End If
Next
MsgBox "All done!"
Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shell")
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
End Function
Can someone explain to me why the first two methods (commented "Doesn't work" and "Also doesn't work") fail, but hardcoding the system name works just fine?
EDIT: The lines in the latter script following the condition If Err.number <> 0 Then were updated to provide the error description. Output is as follows, with system names replaced with pseudonyms:
Set objWMIservice = GetObject('winmgmts:\\sys1\root\cimv2') failed from Err.code:Permission denied
Set objWMIservice = GetObject('winmgmts:\\sys3\root\cimv2') failed from Err.code:Permission denied
EDIT2: Further testing shows that it at least one issue is related to successfully finding the service tag of one system, and failing on the following system, which for some reason results in the previous tag being used

How can I pull the correct data from the HK Current User registry key instead of temp profile information

I am working on a script to pull the value in the key
HKCurrentUser\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop
Currently all it is returning is:
C:\WINDOWS\system32\config\systemprofile\Desktop
When I want/think it should return:
%USERPROFILE%\Desktop
Below is the script that is pulling the infomration from the key and as far as I can tell it should be pulling the correct information. Just wondering if someone can enlighten me as to what I am missing. It also returns the computer name and the logged in username which both return correctly. This is going to be run on quite a few machines remotely.
'These are the constants for the following KEYS'
Const HKClassesRoot = &H80000000 'HKEY_CLASSES_ROOT
Const HKCurrentUser = &H80000001 'HKEY_CURRENT_USER
Const HKLocalMachine = &H80000002 'HKEY_LOCAL_MACHINE
Const HKUsers = &H80000003 'HKEY_USERS
Const HKCurrentConfig = &H80000005 'HKEY_CURRENT_CONFIG
'Setup objects to interact with here'
Set wshShell = WScript.CreateObject("Wscript.Shell")
strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Define variable to store the current user and then pull the current user
Dim currentUser
strCurrentUser = objNetwork.UserName
'find the data in the string we want to get the value from'
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\"
strValueName = "Desktop"
'pull the info and store it in strValue'
objRegistry.GetStringValue HKCurrentUser,strKeyPath,strValueName,strValue
'setup for output of data to the file'
Dim strSpacer
Dim strData
strSpace = "+-------------------------------------------------------------------------------------------------------------------------+"
strData = "| " & strComputer & " == " & strCurrentUser & " == " & strValue & " |"
Dim strFileName
strFileName = "\\server\share\" & strCurrentUser & ".txt"
Set objFile = objFSO.OpenTextFile(strFileName,8,true)
objFile.write vbCrLf & strSpace & vbCrLf
objFile.write strData & vbCrLf
objFile.write strSpace & vbCrLf
'Close file'
objFile.Close
After review I found the answer to my own question. I was reading the registry incorrectly for what I was doing.
strRegkey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop"
strDataValue = wshShell.RegRead(strRegKey)
this returns the value stored currently in the key.
I suspect that the environment variable %USERPROFILE% from the registry value gets expanded to the profile of the user running the WMI service (LOCAL SYSTEM). GetStringValue seems to behave the same as GetExpandedStringValue when reading REG_EXPAND_SZ values.

Skipping computers with error

I'm having an issue with a VBScript that looks for printers on computers from a list on an Excel sheet and then finds them through WMI. It matches them through the IP address name and then writes a batch file that I can install them from. My issue is that when I have a computer that is turned off I get a 462 error which is then cleared but then the printers for the previous computer are written again. I'm quite new at this so I'm not sure if I'm just missing something really basic here.
Batch = "printerOutput.txt"
Const ForWriting = 2 'Set to 8 for appending data
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Batch, ForWriting)
On Error Resume Next
Dim printerDictionary 'Create Printer dictionary of names and IP addresses
Set printerDictionary = CreateObject("Scripting.Dictionary")
printerDictionary.Add "Printer","xxx.xxx.xxx.xxx"
Set objExcel_1 = CreateObject("Excel.Application")
' Statement will open the Excel Workbook needed.
Set objWorkbook = objExcel_1.Workbooks.Open _
("x\p.xls")
If Err.Number <> 0 Then
MsgBox "File not Found"
Wscript.Quit
End If
'Checks for errors
f = 1 'Sets variable that will loop through Excel column
Do
' Msgbox f,, "Begining of Do Loop"
strComputer = objExcel_1.Cells(f, 1).Value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
For Each objPrinter in colPrinters 'For ever objPrinter found in the computers WMIService
If Err.Number = 0 Then
objFile.WriteLine Err.Number
If InStr(ObjPrinter.PortName,".") = 4 then 'If the printers IP port name is written like 128.xxx.xxx.xxx
'MsgBox ObjPrinter.Name & " " & ObjPrinter.PortName,, "IfStatement"
PrtDict ObjPrinter.PortName, StrComputer
ElseIf InStr(ObjPrinter.PortName,"_") = 3 Then 'If the printers IP port name is written like IP_128.xxx.xxx.xxx
cleanIP = GetIPAddress(objPrinter.PortName) 'Clean IP
PrtDict cleanIP, StrComputer
End If
Else
objFile.WriteLine "REM " & strComputer & " - Error: " & err.number
Err.Clear
End If
Next
f = f + 1
Loop Until objExcel_1.Cells(f, 1).Value = ""
objExcel_1.ActiveWorkbook.Close
ObjExcel_1.Quit
Function PrtDict(PrtMn, CMP) 'Loops through the dictionary to find a match from the IP address found
For Each x in printerDictionary
'MsgBox PrtMn & "=" & printerDictionary.Item(x),,"InPtrDict"
If printerDictionary.Item(x) = PrtMn Then
objFile.WriteLine "psexec -u \%1 -p %2 " & CMP & " path\" & x & ".bat"
End If
Next
End Function
'100
Function GetIPAddress(Address) 'For cleaning up IP address with names like IP_128.xxx.xxx.xxx
IPtext = InStr(Address,"_")
IPaddress = len(Address) - IPtext
GetIPAddress = Right(Address,IPaddress)
End Function
What happens is this:
On Error Resume Next
This enables error-handling (or rather error suppression) for the rest of the script, since it's never disabled.
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
This command fails, because strComputer is not reachable. Because of the error the variable Err is set and objWMIService retains its previous value.
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
This command succeeds and re-reads the printer list from the previous computer, because objWMIService still refers to that computer.
For Each objPrinter in colPrinters
The script enters the loop, because colPrinters got populated with the printers from the previous computer (again), …
If Err.Number = 0 Then ... Else ... End If
… but because Err is still set, the script goes into the Else branch, where the error is reported and cleared:
objFile.WriteLine "REM " & strComputer & " - Error: " & err.number
Err.Clear
Then the script goes into the next iteration of the loop. Err is now cleared, so the rest of the printers in colPrinters is being processed normally.
Global On Error Resume Next is the root of all evil. Don't do this. EVER.
If you absolutely must use On Error Resume Next, enable error-handling locally, put some actual error handling code in place, and disable error-handling right afterwards. In your case one might implement it like this:
...
Do
strComputer = objExcel_1.Cells(f, 1).Value
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If Err Then
objFile.WriteLine "REM " & strComputer & " - Error: " & err.number
Set objWMIService = Nothing
End If
On Error Goto 0
If Not objWMIService Is Nothing Then
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer")
For Each objPrinter in colPrinters
...
Next
f = f + 1
End If
Loop Until objExcel_1.Cells(f, 1).Value = ""
...

Find Users E-Mail via SID using VBScript and Active Directory

I am parsing log messages about changes to user accounts on a windows system.
I want to notify the user about the changes so I need to retrieve their personal
information (First,Last, E-Mail) from Active Directory.
I already found a way to retrieve the username but that is only via WMI and not ADSI:
Function FindUser(Message)
Dim objWMIService
Dim strAccountRegex
Dim objRegex
Dim objMatch
Dim strComputer
Dim objUser
Dim objShell
strAccountRegex = "(\%\{[A-Z,0-9,\-]*\})"
strComputer = "."
Wscript.StdOut.writeLine "Querying WMI to retrieve user-data"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objShell = WScript.CreateObject("WScript.Shell")
Set objRegex = new RegExp
objRegex.Pattern= strAccountRegex
for each objMatch in objRegex.Execute(Message)
REM Wscript.StdOut.writeLine "Found an Account ID: " & objMatch.value
Dim strSID
strSID=NormalizeSID(objMatch.value)
REM Wscript.Echo "SID after escaping: " & strSID
Set objUser = objWMIService.Get _
("Win32_SID.SID='" & strSID & "'")
next
FindUser=objUser.ReferencedDomainName & "\" & objUser.AccountName
End Function
It works fine, but I would like to do it via Active Directory instead of going via WMI.
Can you help me?
OK. I found a way to do this via Active Directory.
For compeleteness here is the code:
REM Converts the SID into a from, that can be processed by WMI
Function NormalizeSid(strSidToNormalize)
Dim regEx,strReplace
strReplace=""
' Create regular expression.
Set regEx = New RegExp
regEx.Global = True
regEx.Pattern = "(%|{|})"
regEx.IgnoreCase = True
' Make replacement.
NormalizeSid = regEx.Replace(strSidToNormalize, strReplace)
End Function
REM Searches for a SID the in the Message that was passed as argument
REM SID returned will be of the form %{S-1-5-21-3968247570-3627839482-368725868-1110}
REM NOTE: Neither WMI nor ADSI will accept this. Use NormalizeSid like in FindUser
Function FindSidInMessage(Message)
Dim strAccountRegex
Dim objRegex
Dim objMatch
Dim strSID
strAccountRegex = "(\%\{S\-[,0-9,\-]*\})"
Set objRegex = new RegExp
objRegex.Pattern= strAccountRegex
for each objMatch in objRegex.Execute(Message)
REM Wscript.StdOut.writeLine "Found an Account ID: " & objMatch.value
strSID=objMatch.value
next
FindSidInMessage=strSID
End Function
REM Searches Directory for the User matching the SID passed as parameter
Function FindUser(userSID)
Dim normalizedSID
Dim objUser
normalizedSID=NormalizeSid(userSID)
Wscript.Echo "SID after escaping: " & normalizedSID
Wscript.StdOut.writeLine "Querying AD to retrieve user-data"
Set objUser = GetObject("LDAP://<SID="& normalizedSID & ">")
FindUser=objUser.EmailAddress
End Function
Hope this will be useful to others.

VBScript: way to check why the script stopped?

I have this VBScript which runs however, while it is processing, it will randomly stop and require a user to hit the spacebar for it to display the rest of its ongoing output.
How do I figure out why this is happening?
Here is a copy of the script:
'On Error Resume Next
Dim arrFolders()
intSize = 0
Function StampNow()
Dim Hr, Mn, Yr, Mon, Dy, Date1
Date1=Now()
Hr=DatePart("h",Date1)
Mn=DatePart("n",Date1)
Yr = DatePart("yyyy",Date1)
Mon = DatePart("m",Date1)
Dy = DatePart("d",Date1)
StampNow = Yr & "-" & Mon & "-" & Dy
end function
'Output log info.
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\dpadmin_copy2run-"& StampNow & ".bat"
'strText = "dpadmin_copy2"
strText = strToAdd
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists.
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript.
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strFolderName = "D:\1\production\Openjobs"
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
dim diffindates
'Init vars for regex.
Dim retVal, retVal2
Dim Lastprop
Dim objRegExpr 'regex variable
Set objRegExpr = New regexp
Set objRegExprX31 = New regexp
objRegExpr.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9][A-Z][A-Z][A-Z]"
objRegExprX31.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]X31"
objRegExpr.Global = True
objRegExprX31.Global = True
objRegExpr.IgnoreCase = True
objRegExprX31.IgnoreCase = True
'Variables for getting last accessed property.
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
'Current time vars.
Dim currenttime
currenttime = Now()
ParentFolder = "D:\1\Production\Openjobs\ClosedJobs"
For Each objFolder in colSubfolders
intSize = intSize + 1
retVal = objRegExpr.Test(objFolder.Name)
retVal2 = objRegExprX31.Test(objFolder.Name)
if (retVal OR retVal2 ) then
'set filename to array
strFolderName = objFolder.Name
'Get last modified date.
Set f = fs.GetFolder(objFolder.Name)
Lastprop = f.DateLastModified
'MsgBox(Lastprop)
if ( DateDiff("m", f.DateLastModified, Now()) > 4) then
diffindates = DateDiff("m", f.DateLastModified, Now())
Set objShell = CreateObject("Shell.Application")
Set objCopyFolder = objShell.NameSpace(ParentFolder)
OutputToLog("rem " & f.DateLastModified & ":" & objFolder.Name )
outputtolog("move /Y """ & objFolder.Name & """ " & ParentFolder)
wscript.echo(diffindates & ":" & objFolder.Name & vbCr)
end if
end if
Next
Update
It stops at the line:
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
with the error Microsoft VBScript runtime error: Permission denied
I'm a little confusd by this. The logfile was only 356kb
I was able to run your script several times without it pausing for input. Run your script with the //X flag to start it in the debugger:
>cscript //nologo //X dpadmin_copy2.vbs"
You should be able to then step through the code.
You can also start putting in wscript.echo trace statements everywhere and see if you can narrow down what it's waiting on.
One thing that's gotten me in the past; If your command console is in QuickEdit mode and you accidentally click anywhere in the console window, the console will hang while it waits for you to press a key.
Well the first step is to remove any global On Error Resume Next statements. Better feedback would come if we could see the script.
You usually get an Permission denied when trying to write to a text file when the text file already has an open handle from some other process or because you have previously opened a handle earlier in you code which you have not closed. I haven't tried this but I don't know why this wouldn't work, you can look at using Handle from Sysinternals (Microsoft) to tell you what process has the open handle for the file. Please see here for a further reference of how to use Handle: http://www.orcsweb.com/blog/post/Closing-open-file-handles.aspx You could also write a second script which runs in a loop to monitor the main script. The second script can verify the first script by doing a WMI Process query which returns only processes that match a defined command line. The second script could then restart the main it stops, alert you, log a file, launch a handle search, etc.

Resources