?
Solved

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

Posted on 2009-05-07
7
Medium Priority
?
407 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
Containers & Docker to Create a Powerful Team

Containers are an incredibly powerful technology that can provide you and/or your engineering team with huge productivity gains. Using containers, you can deploy, back up, replicate, and move apps and their dependencies quickly and easily.

 
LVL 7

Assisted Solution

by:orcic
orcic earned 800 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 1200 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

Optimize your web performance

What's in the eBook?
- Full list of reasons for poor performance
- Ultimate measures to speed things up
- Primary web monitoring types
- KPIs you should be monitoring in order to increase your ROI

Question has a verified solution.

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

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.
The Windows functions GetTickCount and timeGetTime retrieve the number of milliseconds since the system was started. However, the value is stored in a DWORD, which means that it wraps around to zero every 49.7 days. This article shows how to solve t…
Learn the basics of if, else, and elif statements in Python 2.7. Use "if" statements to test a specified condition.: The structure of an if statement is as follows: (CODE) Use "else" statements to allow the execution of an alternative, if the …
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …
Suggested Courses

770 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