• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 417
  • Last Modified:

vbs code that pings i get a permission error in line 90.

Hi,

vbs code that pings i get a permission error in line 90.
Can anyone help skip and record this error

When this error occurs put the error into the colum and skip that machine and go to next.

REgards
Sharath
Set objExcel = CreateObject("Excel.Application")
 
objExcel.Visible = True
 
objExcel.Workbooks.Add
 
intRow = 2
 
objExcel.Cells(1, 1).Value = "Machine Name"
 
objExcel.Cells(1, 2).Value = "IPAdress"
 
objExcel.Cells(1, 3).Value = "Alive"
 
objExcel.Cells(1, 4).Value = "Dead"
 
objExcel.Cells(1, 5).Value = "MacAdress"
 
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
Set InputFile = fso.OpenTextFile("c:\servers.txt")
 
 
 
Do While Not (InputFile.atEndOfStream)
 
HostName = InputFile.ReadLine
 
If Not HostName = "" then 
 
Set WshShell = WScript.CreateObject("WScript.Shell")
 
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
 
 
 
objExcel.Cells(intRow, 1).Value = HostName
 
objExcel.Cells(intRow, 2).Value = ResolveIP(HostName) 
 
Select Case Ping
 
Case 0 
objExcel.Cells(intRow, 3).Value = "On Line"
If per(HostName) Then
objExcel.Cells(intRow, 5).Value = FindMac(HostName)  
Else
objExcel.Cells(intRow, 5).Value = "You Dont Have Permission To Query " & HostName
End if 
Case 1
objExcel.Cells(intRow, 4).Value = "Off Line"
objExcel.Cells(intRow, 5).Value = "Machine Turn Off"
end select
 
 
intRow = intRow + 1
 
End if
 
Loop
 
 
 
objExcel.Range("A1:B1:C1:D1:E1").Select
 
objExcel.Selection.Interior.ColorIndex = 19
 
objExcel.Selection.Font.ColorIndex = 11
 
objExcel.Selection.Font.Bold = True
 
objExcel.Cells.EntireColumn.AutoFit
 
 
 
Function ResolveIP(computerName)
   Dim objShell  :  Set objShell = CreateObject("WScript.Shell")
   Dim objExec   :  Set objExec = objShell.Exec("ping " & computerName & " -n 1")
   Dim strOutput : strOutput = objExec.StdOut.ReadAll
   Dim RegEx     :  Set RegEx = New RegExp
   RegEx.Pattern = "\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]"
   RegEx.Global = True
   If RegEx.Test(strOutput) Then
       ResolveIP = RegEx.Execute(strOutput)(0).Submatches(0)
   Else
       ResolveIP = "IP Address could not be resolved."
   End If
End Function
 
Function FindMac(ip)
strComputer = ip
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colItems = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
 
For Each objItem in colItems
    FindMac = objItem.MACAddress
Next
End Function
 
Function per(computer)
	strcomputer = computer
	On Error Resume Next
	Set objWMIService = GetObject("winmgmts:" _
	& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	If err.number <> 0 Then
		err.Clear
		per = False
		On Error goto 0
	Else
		per = True
		On Error goto 0
	End If
End Function

Open in new window

0
bsharath
Asked:
bsharath
  • 3
  • 2
  • 2
2 Solutions
 
orcicCommented:
try replacing FindMac function with
Function FindMac(ip)
strComputer = ip
On Error Resume Next
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 If err.number <> 0 Then
  err.Clear
  FindMac = "You Dont Have Permission To Query " & strComputer
  On Error goto 0
  Exit Function  
        End If
 
Set colItems = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
 If err.number <> 0 Then
  err.Clear
  FindMac = "You Dont Have Permission To Query " & strComputer
  On Error goto 0
  Exit Function  
        End If
 
For Each objItem in colItems
    FindMac = objItem.MACAddress
Next
End Function
0
 
bsharathAuthor Commented:
I get this

---------------------------
Windows Script Host
---------------------------
Script:      D:\off.vbs
Line:      46
Char:      1
Error:      Type mismatch: 'per'
Code:      800A000D
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
 
bsharathAuthor Commented:
I get this

---------------------------
Windows Script Host
---------------------------
Script:      D:\off.vbs
Line:      46
Char:      1
Error:      Type mismatch: 'per'
Code:      800A000D
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
orcicCommented:
You probably forgot Per function on the end. The whole script would be ...

Set objExcel = CreateObject("Excel.Application")
 
objExcel.Visible = True
 
objExcel.Workbooks.Add
 
intRow = 2
 
objExcel.Cells(1, 1).Value = "Machine Name"
 
objExcel.Cells(1, 2).Value = "IPAdress"
 
objExcel.Cells(1, 3).Value = "Alive"
 
objExcel.Cells(1, 4).Value = "Dead"
 
objExcel.Cells(1, 5).Value = "MacAdress"
 
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
Set InputFile = fso.OpenTextFile("c:\servers.txt")
 
 
 
Do While Not (InputFile.atEndOfStream)
 
HostName = InputFile.ReadLine
 
If Not HostName = "" then
 
Set WshShell = WScript.CreateObject("WScript.Shell")
 
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
 
 
 
objExcel.Cells(intRow, 1).Value = HostName
 
objExcel.Cells(intRow, 2).Value = ResolveIP(HostName)
 
Select Case Ping
 
Case 0
objExcel.Cells(intRow, 3).Value = "On Line"
If per(HostName) Then
objExcel.Cells(intRow, 5).Value = FindMac(HostName)  
Else
objExcel.Cells(intRow, 5).Value = "You Dont Have Permission To Query " & HostName
End if
Case 1
objExcel.Cells(intRow, 4).Value = "Off Line"
objExcel.Cells(intRow, 5).Value = "Machine Turn Off"
end select
 
 
intRow = intRow + 1
 
End if
 
Loop
 
 
 
objExcel.Range("A1:B1:C1:D1:E1").Select
 
objExcel.Selection.Interior.ColorIndex = 19
 
objExcel.Selection.Font.ColorIndex = 11
 
objExcel.Selection.Font.Bold = True
 
objExcel.Cells.EntireColumn.AutoFit
 
 
 
Function ResolveIP(computerName)
   Dim objShell  :  Set objShell = CreateObject("WScript.Shell")
   Dim objExec   :  Set objExec = objShell.Exec("ping " & computerName & " -n 1")
   Dim strOutput : strOutput = objExec.StdOut.ReadAll
   Dim RegEx     :  Set RegEx = New RegExp
   RegEx.Pattern = "\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]"
   RegEx.Global = True
   If RegEx.Test(strOutput) Then
       ResolveIP = RegEx.Execute(strOutput)(0).Submatches(0)
   Else
       ResolveIP = "IP Address could not be resolved."
   End If
End Function
 
Function FindMac(ip)
strComputer = ip
On Error Resume Next
Set objWMIService = GetObject("winmgmts:" _
   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
If err.number <> 0 Then
 err.Clear
 FindMac = "You Dont Have Permission To Query " & strComputer
 On Error goto 0
 Exit Function  
End If
Set colItems = objWMIService.ExecQuery _
   ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
If err.number <> 0 Then
 err.Clear
 FindMac = "You Dont Have Permission To Query " & strComputer
 On Error goto 0
 Exit Function  
End If
For Each objItem in colItems
   FindMac = objItem.MACAddress
Next
End Function
 
Function per(computer)
 strcomputer = computer
 On Error Resume Next
 Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 If err.number <> 0 Then
  err.Clear
  per = False
  On Error goto 0
 Else
  per = True
  On Error goto 0
 End If
End Function
 

 
 
0
 
PakaCommented:
Try this code, I added error trapping for each function (and used SourceFormatX to format the code:

Set objExcel = CreateObject("Excel.Application")
 
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "IPAdress"
objExcel.Cells(1, 3).Value = "Alive"
objExcel.Cells(1, 4).Value = "Dead"
objExcel.Cells(1, 5).Value = "MacAdress"
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("c:\servers.txt")
 
Do While Not (InputFile.AtEndOfStream)
    HostName = InputFile.ReadLine
    If Not HostName = "" Then
        Set WshShell = WScript.CreateObject("WScript.Shell")
        Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
        objExcel.Cells(intRow, 1).Value = HostName
        objExcel.Cells(intRow, 2).Value = ResolveIP(HostName)
        
        Select Case Ping
            Case 0
                objExcel.Cells(intRow, 3).Value = "On Line"
                If per(HostName) Then
                    objExcel.Cells(intRow, 5).Value = FindMac(HostName)
                Else
                    objExcel.Cells(intRow, 5).Value = "You Dont Have Permission To Query " & HostName
                End If
                
            Case 1
                objExcel.Cells(intRow, 4).Value = "Off Line"
                objExcel.Cells(intRow, 5).Value = "Machine Turn Off"
        End Select
        
        intRow = intRow + 1
    End If
Loop
 
objExcel.Range("A1:B1:C1:D1:E1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
 
 
Function ResolveIP(computerName)
 
    On Error Resume Next
 
    Dim objShell
    Set objShell = CreateObject("WScript.Shell")
    Dim objExec
    Set objExec = objShell.Exec("ping " & computerName & " -n 1")
    Dim strOutput
    Dim RegEx
 
    Set RegEx = New RegExp
    strOutput = objExec.StdOut.ReadAll
 
    RegEx.Pattern = "\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]"
    RegEx.Global = True
 
    If RegEx.Test(strOutput) Then
        ResolveIP = RegEx.Execute(strOutput)(0).Submatches(0)
    
        If Err.Number <> 0 Then
          Err.Clear
          ResolveIP = "ResolveIPError - RegEx.execute"
         End If
 
    Else
        ResolveIP = "IP Address could not be resolved."
    End If
    
    On Error GoTo 0
 
End Function
 
Function FindMac(ip)
 
    On Error Resume Next
 
    strComputer = ip
    Set objWMIService = GetObject("winmgmts:" _
                        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    
    If Err.Number <> 0 Then
      Err.Clear
      findMac = "FindMACError - GetObject"
    End If
    
    Set colItems = objWMIService.ExecQuery _
                   ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
 
    If Err.Number <> 0 Then
      Err.Clear
      findMac = "FindMACError - ExecQuery"
    End If
    
    For Each objItem in colItems
        FindMac = objItem.MACAddress
    Next
 
    On Error GoTo 0    
End Function
 
Function per(computer)
    On Error Resume Next
    
    strcomputer = computer
    Set objWMIService = GetObject("winmgmts:" _
                        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
                            
    If Err.Number <> 0 Then
        Err.Clear
        per = False
        On Error GoTo 0
    Else
        per = True
    End If
    
        
End Function

Open in new window

0
 
PakaCommented:
Let's try that one more time.  I forgot to reset the error handler before the functions return.

Set objExcel = CreateObject("Excel.Application")
 
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Machine Name"
objExcel.Cells(1, 2).Value = "IPAdress"
objExcel.Cells(1, 3).Value = "Alive"
objExcel.Cells(1, 4).Value = "Dead"
objExcel.Cells(1, 5).Value = "MacAdress"
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("c:\servers.txt")
 
Do While Not (InputFile.AtEndOfStream)
    HostName = InputFile.ReadLine
    If Not HostName = "" Then
        Set WshShell = WScript.CreateObject("WScript.Shell")
        Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
        objExcel.Cells(intRow, 1).Value = HostName
        objExcel.Cells(intRow, 2).Value = ResolveIP(HostName)
        
        Select Case Ping
            Case 0
                objExcel.Cells(intRow, 3).Value = "On Line"
                If per(HostName) Then
                    objExcel.Cells(intRow, 5).Value = FindMac(HostName)
                Else
                    objExcel.Cells(intRow, 5).Value = "You Dont Have Permission To Query " & HostName
                End If
                
            Case 1
                objExcel.Cells(intRow, 4).Value = "Off Line"
                objExcel.Cells(intRow, 5).Value = "Machine Turn Off"
        End Select
        
        intRow = intRow + 1
    End If
Loop
 
objExcel.Range("A1:B1:C1:D1:E1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
 
 
Function ResolveIP(computerName)
 
    On Error Resume Next
 
    Dim objShell
    Set objShell = CreateObject("WScript.Shell")
    Dim objExec
    Set objExec = objShell.Exec("ping " & computerName & " -n 1")
    Dim strOutput
    Dim RegEx
 
    Set RegEx = New RegExp
    strOutput = objExec.StdOut.ReadAll
 
    RegEx.Pattern = "\[(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]"
    RegEx.Global = True
 
    If RegEx.Test(strOutput) Then
        ResolveIP = RegEx.Execute(strOutput)(0).Submatches(0)
    
        If Err.Number <> 0 Then
          Err.Clear
          On Error GoTo 0
          ResolveIP = "ResolveIPError - RegEx.execute"
         End If
 
    Else
        ResolveIP = "IP Address could not be resolved."
    End If
 
    On Error GoTo 0
    
End Function
 
Function FindMac(ip)
 
    On Error Resume Next
 
    strComputer = ip
    Set objWMIService = GetObject("winmgmts:" _
                        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    
    If Err.Number <> 0 Then
      Err.Clear
      On Error GoTo 0
      findMac = "FindMACError - GetObject"
    End If
    
    Set colItems = objWMIService.ExecQuery _
                   ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
 
    If Err.Number <> 0 Then
      Err.Clear
      On Error GoTo 0
      findMac = "FindMACError - ExecQuery"
    End If
    
    For Each objItem in colItems
        FindMac = objItem.MACAddress
    Next
 
    On Error GoTo 0
        
End Function
 
Function per(computer)
    On Error Resume Next
    
    strcomputer = computer
    Set objWMIService = GetObject("winmgmts:" _
                        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
                            
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        per = False
    Else
        per = True
    End If
 
    On Error GoTo 0
       
End Function

Open in new window

0
 
bsharathAuthor Commented:
Thank U
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now