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

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

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  
---------------------------

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  
---------------------------

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

Select allOpen in new window

Thank U