Solved

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

Posted on 2009-05-07
7
397 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
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!

 
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

Guide to Performance: Optimization & Monitoring

Nowadays, monitoring is a mixture of tools, systems, and codes—making it a very complex process. And with this complexity, comes variables for failure. Get DZone’s new Guide to Performance to learn how to proactively find these variables and solve them before a disruption occurs.

Question has a verified solution.

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

This script will sweep a range of IP addresses (class c only, 255.255.255.0) and report to a log the version of office installed. What it does: 1.)      Creates log file in the directory the script is run from (if it doesn't already exist) 2.)      Sweep…
This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
Learn the basics of lists in Python. Lists, as their name suggests, are a means for ordering and storing values. : Lists are declared using brackets; for example: t = [1, 2, 3]: Lists may contain a mix of data types; for example: t = ['string', 1, T…
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…

738 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