GetObject("winmgmts:... crashes Excel 2016 with no Errors

Question

I am debugging some VBA code I've written in Excel 2016, and this sub is crashing Excel 2016 on windows Server with no errors.

It is crashing on the Set RegObj = GetObject...

Sub TestPrinter()
    On Error GoTo e
    Dim RegObj As Object
    'This next line is where the crash occurs...
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Exit Sub
e:
    MsgBox "Error number " & Err & " in TestPrinter" & vbCrLf & "Error: " & Error$(Err)
End Sub

My end goal is to enumerate the printers connected on the machine, and then set Application.ActivePrinter based on the string I pull out of the registry. This code is working fine on every other machine I've tried it on - but fails on this one server.

How can I go about debugging this? The error handler is never hit.

Answer 1

This does not answer your question but rather provides an alternative solution to setting the active printer.

You can use something like this to get the printer names:

Public Function GetPrinterNames() As Collection
    Dim coll As New Collection
    Dim i As Long
    '
    On Error Resume Next
    With CreateObject("WScript.Network")
        For i = 1 To .EnumPrinterConnections.Count Step 2
            coll.Add .EnumPrinterConnections(i)
        Next
    End With
    On Error GoTo 0
    Set GetPrinterNames = coll
End Function

Note that the above does NOT give you the port number but that is not really necessary as you could use something like this to set the printer:

'*******************************************************************************
'Sets the ActivePrinter without requiring the winspool port number
'*******************************************************************************
Public Function SetPrinter(ByVal printerName As String) As Boolean
    If LenB(printerName) = 0 Then Exit Function
    Dim i As Long
    '
    On Error Resume Next
    Application.ActivePrinter = printerName
    If Err.Number = 0 Then
        SetPrinter = True
        Exit Function
    End If
    Err.Clear
    For i = 0 To 99
        Application.ActivePrinter = printerName & " on NE" & Format$(i, "00:")
        If Err.Number = 0 Then
            SetPrinter = True
            Exit Function
        End If
        Err.Clear
    Next i
    On Error GoTo 0
End Function