Solved

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

Posted on 2009-05-07
7
394 Views
Last Modified: 2012-05-06
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
Comment
Question by:bsharath
  • 3
  • 2
  • 2
7 Comments
 
LVL 7

Expert Comment

by:orcic
ID: 24333838
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
 
LVL 11

Author Comment

by:bsharath
ID: 24333883
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
 
LVL 11

Author Comment

by:bsharath
ID: 24333884
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
Master Your Team's Linux and Cloud Stack!

The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.

 
LVL 7

Assisted Solution

by:orcic
orcic earned 200 total points
ID: 24334112
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
 
LVL 22

Expert Comment

by:Paka
ID: 24334172
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
 
LVL 22

Accepted Solution

by:
Paka earned 300 total points
ID: 24334200
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
 
LVL 11

Author Comment

by:bsharath
ID: 24347825
Thank U
0

Featured Post

Resolve Critical IT Incidents Fast

If your data, services or processes become compromised, your organization can suffer damage in just minutes and how fast you communicate during a major IT incident is everything. Learn how to immediately identify incidents & best practices to resolve them quickly and effectively.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Learn the basics of while and for loops in Python.  while loops are used for testing while, or until, a condition is met: The structure of a while loop is as follows:     while <condition>:         do something         repeate: The break statement m…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question