VBa function return "RPC server unavailable" - win7

[nemmi69]

I am running the following code to check if certain programs are running.

[/FONT][/COLOR]'######################################################'Function ProcessIsRunning checks if the process name
' supplied is running.
'######################################################
Function ProcessIsRunning(ByVal ProcessIP As String) As Integer
On Error GoTo Error_Handler
    
    Dim FSReply As Integer 'function name
    Dim ProcFnd1 As Boolean 'stops multiple hits
    Dim ProcFnd2 As Boolean ' - / -
    Dim ProcFnd3 As Boolean ' - / -
    Dim objLocator As Object
    Dim objWMI As Object
    Dim objList As Object
    Dim objService As Object
    
    If Trim(ProcessIP) = "" Then
        ProcessIsRunning = -2
        Exit Function
    End If
    
    'Get admin password
    UFormPword.Show


    'Access remote as admin
    Set objLocator = CreateObject("WbemScripting.SWbemLocator")
    Set objWMI = objLocator.ConnectServer(ProcessIP, "root\cimv2", "wtbadmin", APbwcrd)
    'Retrieve running processes
    FSReply = 0
    ProcFnd1 = 0
    ProcFnd2 = 0
    ProcFnd3 = 0
    Set objList = objWMI.ExecQuery("SELECT * FROM Win32_Process" & _
        " WHERE Name = 'TestMgr.exe'" & " OR Name = 'iTestConsole.exe'" & " OR Name = 'tdefine.exe'", , 48)
    
    For Each objService In objList
        If objService.Name = "TestMgr.exe" And ProcFnd1 = 0 Then
            FSReply = FSReply + 1
            ProcFnd1 = 1
        End If
        If objService.Name = "iTestConsole.exe" And ProcFnd2 = 0 Then
            FSReply = FSReply + 2
            ProcFnd2 = 1
        End If
'        If objService.Name = "tdefine.exe" And ProcFnd3 = 0 Then
'            FSReply = FSReply + 4
'            ProcFnd3 = 1
'        End If
    Next
    ProcessIsRunning = FSReply
    
Error_Handler_Exit:
    On Error Resume Next
    Set objLocator = Nothing
    Set objList = Nothing
    Set objWMI = Nothing
    Set objService = Nothing
    Exit Function


Error_Handler:
    ProcessIsRunning = -1
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error From: ProcessIsRunning" & vbCrLf & _
            "Error Number: " & Str(Err.Number) & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit


End Function


[COLOR=#242729][FONT=Arial]

On another PC that is doing exactly the same job this works without fault.
I know the IP is OK as I can open file explorer and using the IP see the shared directories. Also the IP is pingable. Checked with nslookup that the IP returns the correct host name and the host name returns the correct IP.
I have checked the firewall and it is OK I have checked services.msc and made sure that the RPC WMI services are running.
I have checked the registry values I have checked Internet connection and its protocols
Have about run out of ideas

 

[RoryA]

You haven't actually said what's happening where or what debugging you have done. Does the error occur here:

Set objWMI = objLocator.ConnectServer(ProcessIP, "root\cimv2", "wtbadmin", APbwcrd)

?

Based on your other post, it's clearly not an issue with the code or Excel.

 

[nemmi69]

Nope, just hoping someone else had run in to the issue and knew how to solve it.