VB Script check registry file, error handling for if online, offline, dns/ip conflict ERRORs.

##VBscript to check for a registry key on a text file of workstations works, but if the workstation is offline or had a DNS/IP conflict script crashes. I am struggling with adding logic to check for if it pings output the regitry setting, if it is offline or dns/ip conflict output the issue. Any help would be appreicated.##


' Set the constants
Const HKEY_LOCAL_MACHINE = &H80000002
Const ForAppending = 8

' Create FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile ("C:\outputfile.csv", ForAppending, True)

arrComputers = Split(objFSO.OpenTextFile("C:\inputfile.txt").ReadAll, vbNewLine)

for each strComputer in arrComputers
  'wscript.echo "Examining " & strComputer
  Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
  objFile.WriteLine "Workstation Name: " & strComputer
  strKeyPath = "Software\ODBC\ODBC.INI\somesetting"
  strValueName = "Server"
  oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
  objFile.WriteLine("Current ODBC Setting: " & strValue)


0 Comments   [ + ] Show comments

Answers (1)

Posted by: anonymous_9363 5 years ago
Red Belt

First, please apply the CODE style to your code. It makes the post easier to read.

Second, try this:

Public strMsg
Public strLogText

If WMIPing(strComputer) Then
 '// Do something with the machine
 '// Write out to your log that the machine isn't present
End If

Function WMIPing(ByVal strMachineNameOrIP)
 '// Returns True if strMachineNameOrIP is alive or False if dead
 Dim objPing 
 Dim objStatus 
 Dim intStatus 
 On Error Resume Next

 WMIPing  = False
 Set objPing  = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strMachineNameOrIP & "'")     

 If Err.Number <> 0 Then
  strMsg  = "Function WMIPing: Unable to create WMI Ping object" & vbCRLF
  If Len(strLogText) > 0 Then
   strLogText = strLogText & vbCRLF & vbCRLF & strMsg
   strLogText = strMsg
  End If
  On Error Goto 0
  Exit Function
 End If
 For Each objStatus In objPing   
  intStatus = objStatus.StatusCode

  Select Case intStatus
   Case 0 '// Success
    WMIPing = True
   Case 11001 '// Buffer Too Small
   Case 11002 '// Destination Net Unreachable
   Case 11003 '// Destination Host Unreachable
   Case 11004 '// Destination Protocol Unreachable
   Case 11005 '// Destination Port Unreachable
   Case 11006 '// No Resources
   Case 11007 '// Bad Option
   Case 11008 '// Hardware Error
   Case 11009 '// Packet Too Big
   Case 11010 '// Request Timed Out
   Case 11011 '// Bad Request
   Case 11012 '// Bad Route
   Case 11013 '// TimeToLive Expired Transit
   Case 11014 '// TimeToLive Expired Reassembly
   Case 11015 '// Parameter Problem
   Case 11016 '// Source Quench
   Case 11017 '// Option Too Big
   Case 11018 '// Bad Destination
   Case 11032 '// Negotiating IPSEC
   Case 11050 '// General Failure
  End Select
 On Error Goto 0
  Set objPing = Nothing
End Function

I haven't added the necessary code to "plug in" to yours: I'll leave that to you.

Third, your code urgently needs some error-trapping. Remember: in your code, always assume that NOTHING will work! For example, turn this:

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile ("C:\outputfile.csv", ForAppending, True)

into this:

Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not IsObject(objFSO) Then
 '// Exit with an appropriate message
End If

Set objFile = objFSO.OpenTextFile ("C:\outputfile.csv", ForAppending, True)
If Not IsObject(objFile) Then
 '// Exit with an appropriate message
End If

and so on. It seems like a monumental PITA but it means your code is robust and that it will cope with any eventuality.

For generic error-handling, I am a long-term user of a routine that somebody created using Bruce McKinney's BugAssert function as inspiration.

Don't be a Stranger!

Sign up today to participate, stay informed, earn points and establish a reputation for yourself!

Sign up! or login

View more:


This website uses cookies. By continuing to use this site and/or clicking the "Accept" button you are providing consent Quest Software and its affiliates do NOT sell the Personal Data you provide to us either when you register on our websites or when you do business with us. For more information about our Privacy Policy and our data protection efforts, please visit GDPR-HQ