Can you give us some help Erich? Where/how does it not work, what happens?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Erich Neuwirth" wrote in message
...
I found some VB code which is supposed to do exactly what I need.
It seems not to work in VBA as is.
Do we have anybody here who can look at the code and make it workin VBA?




Option Explicit

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
pAuthInfo 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_IDispatch 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 binary 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

' To use the CreateObjectEx function, simply put the code into any
' Visual Basic module and then call it.
' The class can take the form of a
' programmatic identifier(ProgID) such as Word.Application or the
' equivalent CLSID (in this case,
' {000209FE-0000-0000-C000-000000000046}).
' Note that if a ProgID is 'supplied, the local registry
' is searched for the corresponding CLSID.
' This function could be enhanced to read the remote computer's registry
' instead.
' The optional RemoteServerName parameter references
' the computer on 'which the object is to be run.
' If a remote server name is not provided,
' the function creates the object on the local machine,
' analogous to the behavior of the standard CreateObject function.
' The RemoteServerName parameter can be set to the computer name
' of the remote machine, as in \\server (or just server),
' or the Domain Name System (DNS) name, such as server.com,
www.microsoft.com,
' or 199.34.57.30.
' The following code shows some sample invocations of the
' CreateObjectEx function:

Private Sub Form_Click()
Dim x As Object

' Create object based on ProgID.
Set x = CreateObjectEx("Application.Object", "\\Machine")

' Create object based on CLSID.
Set x = CreateObjectEx("{????????-????-????-????-????????????}", _
"Machine")

' Create object on local machine.
Set x = CreateObjectEx("Application.Object")
End Sub


Sub xxx()
Dim x As Object
Set x = CreateObjectEx("{18C8B661-81A2-11D3-9254-00E09812F727}")
End Sub