CreateObjectEx VBA to create remote COM object

In my library are some venerable COM books, an excellent tome is by Guy and Henry Eddon, called Inside Distributed COM ISBN 1-57231-849-X.  This has undergone some revisions and was last retitled Inside COM+ Base Services.  There are precious few examples of Visual Basic code, but here is a beauty that allows the creation of a COM server on a remote machine, a capability that C++ developers have always had but which is not easily achieved in VB/VBA.

Enjoy some vintage 1998 code, published under fair usage provisions.

Option Explicit

'* From Inside Distributed DCOM
'* By Guy Eddon and Henry Eddon
'* Copyright 1998 By Guy Eddon and Henry Eddon
'* ISBN 1-57231-849-X
'* Microsoft Press
'* https://www.amazon.co.uk/Inside-Distributed-COM-Guy-Eddon/dp/157231849X

'* Part I: Fudamental Programming Architecture
'* Chapter Three: Type Libraries and Language Integration
'* pages 106-108

'* excerpt published under fair usage provisions

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Type COSERVERINFO
    dwReserved1 As Long  ' DWORD
    pwszName As Long     ' LPWSTR
    pAuthorInfo As Long  ' COAUTHINFO
    dwReserved2 As Long  ' DWORD
End Type

Private Type MULTI_QI
    piid As Long    ' const IID+
    pitf As Object  ' IUnknown
    hr As Long      ' HRESULT
End Type

Enum CLSCTX
    CLSCTX_INPROC_SERVER = 1
    CLSCTX_INPROC_HANDLER = 2
    CLSCTX_LOCAL_SERVER = 4
    CLSCTX_REMOTE_SERVER = 16
    CLSCTX_SERVER = CLSCTX_INPROC_SERVER + CLSCTX_LOCAL_SERVER + _
                CLSCTX_REMOTE_SERVER
    
    CLSCTX_ALL = CLSCTX_INPROC_SERVER + CLSCTX_INPROC_HANDLER + _
            CLSCTX_LOCAL_SERVER + CLSCTX_REMOTE_SERVER
End Enum

Private Const GMEM_FIXED = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Declare Function GlobalAlloc Lib "kernel32" _
    (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
    (ByVal hMem As Long) As Long
Private Declare Function IIDFromString Lib "OLE32" _
    (ByVal lpszIID As String, ByVal piid As Long) As Long
Private Declare Function CLSIDFromString Lib "OLE32" _
    (ByVal lpszCLSID As String, pclsid As GUID) As Long
Private Declare Function CLSIDFromProgID Lib "OLE32" _
    (ByVal lpszProgID As String, pclsid As GUID) As Long
Private Declare Function CoCreateInstanceEx Lib "OLE32" _
    (rclsid As GUID, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, _
    pServerInfo As COSERVERINFO, ByVal cmq As Long, _
    rgmqResults As MULTI_QI) As Long
Private Declare Function lstrcpyW Lib "kernel32" _
    (ByVal lpString1 As String, ByVal lpString2 As String) As Long
    
Public Function CreateObjectEx(ByVal Class As String, _
    Optional ByVal RemoteServerName As String = "") As Object
    
    Dim rclsid As GUID
    Dim hr As Long
    Dim ServerInfo As COSERVERINFO
    Dim Context As Long
    Dim mqi As MULTI_QI
    
    mqi.piid = GlobalAlloc(GMEM_FIXED, 16)
    ' Convert the string version of IID_Dispatch to a binary IID.
    hr = IIDFromString(StrConv(IID_IDispatch, vbUnicode), mqi.piid)
    If hr <> 0 Then Err.Raise hr
        
    ' Convert the CLSID or ProgID string to a binary CLSID.
    If ((Left(Class, 1) = "{") And (Right(Class, 1) = "}") And _
        (Len(Class) = 38)) Then
        ' Create a binary CLSID from string representation
        hr = CLSIDFromString(StrConv(Class, vbUnicode), rclsid)
        If hr <> 0 Then Err.Raise hr
    Else
        ' Create a binry CLSID from a ProgID string.
        hr = CLSIDFromProgID(StrConv(Class, vbUnicode), rclsid)
        If hr <> 0 Then Err.Raise hr
    End If

    ' Set up the class context
    If RemoteServerName = "" Then
        Context = CLSCTX_SERVER
    Else
        Context = CLSCTX_REMOTE_SERVER
        Dim MachineArray() As Byte
        ReDim MachineArray(Len(StrConv(RemoteServerName, _
            vbUnicode)) + 1)
        ServerInfo.pwszName = lstrcpyW(MachineArray, _
                StrConv(RemoteServerName, vbUnicode))
    End If

    
    ' Create the object
    hr = CoCreateInstanceEx(rclsid, 0, Context, ServerInfo, 1, mqi)
    If hr <> 0 Then Err.Raise hr
    GlobalFree mqi.piid
    Set CreateObjectEx = mqi.pitf
End Function

Sub TestCreateObjectEx()
    Dim obj(0 To 1) As Object
    Set obj(0) = CreateObjectEx("Scripting.Dictionary")
    Debug.Assert TypeName(obj(0)) = "Dictionary"
    Set obj(1) = CreateObjectEx("{EE09B103-97E0-11CF-978F-00A02463E06F}")
    Debug.Assert TypeName(obj(1)) = "Dictionary"
    
End Sub

I only have one machine at the moment and cannot test the remoting functionality. But this shows good use of COM System functions