Solved

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

Posted on 2009-05-07
7
388 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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
Active Directory replication delay is the cause to many problems.  Here is a super easy script to force Active Directory replication to all sites with by using an elevated PowerShell command prompt, and a tool to verify your changes.
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 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 …

706 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

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now