ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Creating remote objects (https://www.excelbanter.com/excel-programming/294477-creating-remote-objects.html)

Erich Neuwirth
Creating remote objects
 
I know how to create a DCOM object on a remote server using CreateObject
in VBA.
To do so, the object has to be registered on the client machine.
Then it can be created by using its name, e.g.
CreateObject("Excel.Worksheet","remotemachine")

Some other MS tools (Visual FoxPro for example)
have a procedure
CreateObjectEx
which allows to use the CLSID
(the strange thing like "{98de59a0-d175-11cd-a7bd-00006b827d94}")
instead of a name to create the remote object without a registry entry
on the local client machine.

Does anybody have a way of doing this in VBA?
The convenience is that then it is possible to install
a client in an Excel Addin accessing a remote server
without the need of running an installation program with
Administrator rights on the client.

Bob Phillips[_6_]
Creating remote objects
 
Hi Erich,

Don't have an answer to the question, but I knocked up a little function to
return a ProgID from a CLSID. To run it, you just issue

sProgID = GetProgID("{00024500-0000-0000-C000-000000000046}")

which returns "Excel.Application.9"

or i n your instance, use

CreateObject(GetProgID("{00024500-0000-0000-C000-000000000046}")
,"remotemachine")



Option Explicit

'CLSID/GUID structure
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

'API Declarations
Private Declare Function ProgIDFromCLSID Lib "ole32.dll" _
(pCLSID As GUID, _
lpszProgID As Long) As Long

Private Declare Function CLSIDFromString Lib "ole32.dll" _
(ByVal lpszProgID As Long, _
pCLSID As GUID) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)

Function GetProgID(CLSID As String)
Dim sProgID As String * 255
Dim pProgID As Long
Dim udtCLSID As GUID
Dim sCLSID As String * 255
Dim pCLSID As Long
Dim lngRet As Long

sCLSID = CLSID

'Convert the string back to CLSID
lngRet = CLSIDFromString(StrPtr(sCLSID), udtCLSID)

'Get a pointer to ProgID string. This is a Unicode string.
lngRet = ProgIDFromCLSID(udtCLSID, pProgID)

'Get the ProgID and display it.
StringFromPointer pProgID, sProgID
GetProgID = sProgID

End Function

'This function takes a pointer to a Unicode string, a string buffer
'and place the bytes in the Visual Basic string buffer.

Private Sub StringFromPointer(pOLESTR As Long, strOut As String)
Dim ByteArray(255) As Byte
Dim intTemp As Integer
Dim intCount As Integer
Dim i As Integer

intTemp = 1

'Walk the string and retrieve the first byte of each WORD.
While intTemp < 0
CopyMemory intTemp, ByVal pOLESTR + i, 2
ByteArray(intCount) = intTemp
intCount = intCount + 1
i = i + 2
Wend

'Copy the byte array to our string.
CopyMemory ByVal strOut, ByteArray(0), intCount
End Sub



--

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 know how to create a DCOM object on a remote server using CreateObject
in VBA.
To do so, the object has to be registered on the client machine.
Then it can be created by using its name, e.g.
CreateObject("Excel.Worksheet","remotemachine")

Some other MS tools (Visual FoxPro for example)
have a procedure
CreateObjectEx
which allows to use the CLSID
(the strange thing like "{98de59a0-d175-11cd-a7bd-00006b827d94}")
instead of a name to create the remote object without a registry entry
on the local client machine.

Does anybody have a way of doing this in VBA?
The convenience is that then it is possible to install
a client in an Excel Addin accessing a remote server
without the need of running an installation program with
Administrator rights on the client.

Erich Neuwirth
Creating remote objects
 
Hi Bob,

Thanks for the code,
but I fear the code still needs a registry entry on the client machine
to be able to find the ProgID from the CSLID.

I know the CLSID, but it is not in the registry,
and I need to call the remote machine with the CLSID.

I think you code uses the client registry to
find the ProgID and then CreateObject again uses the registry
to translate the ProgID back to the CLSID.


Erich



Bob Phillips wrote:

Hi Erich,

Don't have an answer to the question, but I knocked up a little function to
return a ProgID from a CLSID. To run it, you just issue

sProgID = GetProgID("{00024500-0000-0000-C000-000000000046}")

which returns "Excel.Application.9"

or i n your instance, use

CreateObject(GetProgID("{00024500-0000-0000-C000-000000000046}")
,"remotemachine")



Option Explicit

'CLSID/GUID structure
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

'API Declarations
Private Declare Function ProgIDFromCLSID Lib "ole32.dll" _
(pCLSID As GUID, _
lpszProgID As Long) As Long

Private Declare Function CLSIDFromString Lib "ole32.dll" _
(ByVal lpszProgID As Long, _
pCLSID As GUID) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)

Function GetProgID(CLSID As String)
Dim sProgID As String * 255
Dim pProgID As Long
Dim udtCLSID As GUID
Dim sCLSID As String * 255
Dim pCLSID As Long
Dim lngRet As Long

sCLSID = CLSID

'Convert the string back to CLSID
lngRet = CLSIDFromString(StrPtr(sCLSID), udtCLSID)

'Get a pointer to ProgID string. This is a Unicode string.
lngRet = ProgIDFromCLSID(udtCLSID, pProgID)

'Get the ProgID and display it.
StringFromPointer pProgID, sProgID
GetProgID = sProgID

End Function

'This function takes a pointer to a Unicode string, a string buffer
'and place the bytes in the Visual Basic string buffer.

Private Sub StringFromPointer(pOLESTR As Long, strOut As String)
Dim ByteArray(255) As Byte
Dim intTemp As Integer
Dim intCount As Integer
Dim i As Integer

intTemp = 1

'Walk the string and retrieve the first byte of each WORD.
While intTemp < 0
CopyMemory intTemp, ByVal pOLESTR + i, 2
ByteArray(intCount) = intTemp
intCount = intCount + 1
i = i + 2
Wend

'Copy the byte array to our string.
CopyMemory ByVal strOut, ByteArray(0), intCount
End Sub

Bob Phillips[_6_]
Creating remote objects
 
Erich,

It would need the registry to get the ProgID, that is what the APIs do.Could
you not run a macro on the remote machine that returns that ProgId for you?

--

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
...
Hi Bob,

Thanks for the code,
but I fear the code still needs a registry entry on the client machine
to be able to find the ProgID from the CSLID.

I know the CLSID, but it is not in the registry,
and I need to call the remote machine with the CLSID.

I think you code uses the client registry to
find the ProgID and then CreateObject again uses the registry
to translate the ProgID back to the CLSID.


Erich



Bob Phillips wrote:

Hi Erich,

Don't have an answer to the question, but I knocked up a little function
to
return a ProgID from a CLSID. To run it, you just issue

sProgID = GetProgID("{00024500-0000-0000-C000-000000000046}")

which returns "Excel.Application.9"

or i n your instance, use

CreateObject(GetProgID("{00024500-0000-0000-C000-000000000046}")
,"remotemachine")



Option Explicit

'CLSID/GUID structure
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

'API Declarations
Private Declare Function ProgIDFromCLSID Lib "ole32.dll" _
(pCLSID As GUID, _
lpszProgID As Long) As Long

Private Declare Function CLSIDFromString Lib "ole32.dll" _
(ByVal lpszProgID As Long, _
pCLSID As GUID) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)

Function GetProgID(CLSID As String)
Dim sProgID As String * 255
Dim pProgID As Long
Dim udtCLSID As GUID
Dim sCLSID As String * 255
Dim pCLSID As Long
Dim lngRet As Long

sCLSID = CLSID

'Convert the string back to CLSID
lngRet = CLSIDFromString(StrPtr(sCLSID), udtCLSID)

'Get a pointer to ProgID string. This is a Unicode string.
lngRet = ProgIDFromCLSID(udtCLSID, pProgID)

'Get the ProgID and display it.
StringFromPointer pProgID, sProgID
GetProgID = sProgID

End Function

'This function takes a pointer to a Unicode string, a string
buffer
'and place the bytes in the Visual Basic string buffer.

Private Sub StringFromPointer(pOLESTR As Long, strOut As String)
Dim ByteArray(255) As Byte
Dim intTemp As Integer
Dim intCount As Integer
Dim i As Integer

intTemp = 1

'Walk the string and retrieve the first byte of each WORD.
While intTemp < 0
CopyMemory intTemp, ByVal pOLESTR + i, 2
ByteArray(intCount) = intTemp
intCount = intCount + 1
i = i + 2
Wend

'Copy the byte array to our string.
CopyMemory ByVal strOut, ByteArray(0), intCount
End Sub

Tom Ogilvy
Creating remote objects
 
http://support.microsoft.com/default...b;EN-US;183544
HOWTO: Call CLSID And ProgID Related COM APIs in Visual Basic

http://support.microsoft.com/default...17&Product=vbb
HOWTO: Create a DCOM Client/Server Application by Using Visual Basic

The second has some additional references. Don't know if these are helpful
or not.

--
Regards,
Tom Ogilvy


"Erich Neuwirth" wrote in message
...
I know how to create a DCOM object on a remote server using CreateObject
in VBA.
To do so, the object has to be registered on the client machine.
Then it can be created by using its name, e.g.
CreateObject("Excel.Worksheet","remotemachine")

Some other MS tools (Visual FoxPro for example)
have a procedure
CreateObjectEx
which allows to use the CLSID
(the strange thing like "{98de59a0-d175-11cd-a7bd-00006b827d94}")
instead of a name to create the remote object without a registry entry
on the local client machine.

Does anybody have a way of doing this in VBA?
The convenience is that then it is possible to install
a client in an Excel Addin accessing a remote server
without the need of running an installation program with
Administrator rights on the client.

Tom Ogilvy
Creating remote objects
 
Is this you?

http://www.amazon.com/exec/obidos/tg...glance&s=books

--
Regards,
Tom Ogilvy


"

Erich Neuwirth
Creating remote objects
 
My problem is that I need to be able to starte the remote server
without a registry entry.
If you use the ProgID on the client, it needs a registry entry on the
client.
To be able to create a registry entry, one needs administrator rights.
That is what I want to avoid.
It can be done with an additional DLL, I just wanted to do it in plain
VBA.



Bob Phillips wrote:

Erich,

It would need the registry to get the ProgID, that is what the APIs do.Could
you not run a macro on the remote machine that returns that ProgId for you?

Erich Neuwirth
Creating remote objects
 
Tom Ogilvy wrote:

Is this you?

http://www.amazon.com/exec/obidos/tg...glance&s=books

Yes, thats me.

Erich Neuwirth
Creating remote objects
 
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

Bob Phillips[_6_]
Creating remote objects
 
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

Bob Phillips[_6_]
Creating remote objects
 
I found a problem in the code (well 2 actually, but you probably don't get
the second).

The first is in these lines

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

VBA doesn't seem tgo like the continuation caharacter (didn't test to see
whetehr VB did or not). I removed the continauation and put it all in one
long line - note that this lost the final +, so I had to re-type

Also, these lines errored as the second was missing the comment marker
(wrap-around in th NG, so it may not apply).

' or the Domain Name System (DNS) name, such as server.com,
www.microsoft.com,
' or 199.34.57.30.

When I fixed these, I was able to create an instance of Word on this
machine, using the ProgId of 'Word.Application', or just Word's CLSID
("{000209Fe-0000-0000-C000-000000000046}").

However, when trying to create on another machine I failed dismally, Kept
getting an error 'Remote machine does not exist or is not available', which
was a big pity as it also tried to raise the error on tht machine, so it
fell over there.

--

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

Tom Ogilvy
Creating remote objects
 
This creates an instance of Word on the local machine from Excel 2000, US
English, Win 2K. I don't have a remote server to go against. But if this
works here, I suspect the problem with a remote server could be with
security settings. This article might give some insights:

http://support.microsoft.com/default...b;en-us;174024
DCOM95 Frequently Asked Questions

This article basically seems like it might have been the original source for
the code you found, but there are some differences which might be
significant. Your code makes some assumptions about early and late binding
and the use of the constant with a word guid seems strange if your not going
against word.

http://support.microsoft.com/default...17&Product=vbb
HOWTO: Control Server Location in a Visual Basic Client


Event though an instance of Word can be seen in the task manager (and
terminated there), I couldn't do much with the variable X. It doesn't seem
to be the standard type of reference you get back from CreateObject. All
that said, under VBA6 (xl2000 and later), createobject has a second argument
for servername

CreateObject(class,[servername])



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 on local machine.
Set x = CreateObjectEx("{000209FE-0000-0000-C000-000000000046}")
' x.Visible = True
Debug.Print TypeName(x)

End Sub

--
Regards,
Tom Ogilvy



"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

Erich Neuwirth
Creating remote objects
 
It took me long to answer.
This code solves my Problem:
It creates the server object on a remote machine
without the need for a registry entry on the client machine.


Thanks so much


Tom Ogilvy wrote:

This creates an instance of Word on the local machine from Excel 2000, US
English, Win 2K. I don't have a remote server to go against. But if this
works here, I suspect the problem with a remote server could be with
security settings. This article might give some insights:

http://support.microsoft.com/default...b;en-us;174024
DCOM95 Frequently Asked Questions

This article basically seems like it might have been the original source for
the code you found, but there are some differences which might be
significant. Your code makes some assumptions about early and late binding
and the use of the constant with a word guid seems strange if your not going
against word.

http://support.microsoft.com/default...17&Product=vbb
HOWTO: Control Server Location in a Visual Basic Client


Event though an instance of Word can be seen in the task manager (and
terminated there), I couldn't do much with the variable X. It doesn't seem
to be the standard type of reference you get back from CreateObject. All
that said, under VBA6 (xl2000 and later), createobject has a second argument
for servername

CreateObject(class,[servername])



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 on local machine.
Set x = CreateObjectEx("{000209FE-0000-0000-C000-000000000046}")
' x.Visible = True
Debug.Print TypeName(x)

End Sub

Erich Neuwirth
Creating remote objects
 
Well, I have to correct my forst answer.
The code with Tom Ogilvy's correction (given at the end)
almost does the trick,
but not fully so. Excel almost always crashes when
it is closed after the code has been run.
I tried this eowth XL2K, XLXP, and XL2K3.


I do have a DLL written in C which does the trick.
The problem is that It has to be loaded with a declatre statement,
and for that the DLL has to be in the PATH.
Due to the nature of the project, it would be better if we can
avoid adding to the path.

Can anybody of the VBA masters on this list have a look at this code
and possibly translate it into VBA?




C/C++ code
-=-=-=-=-=-=-=-=-=-=-=-=
DLLTOOLS_API IDispatch* __stdcall CreateRemoteObject(char* pCLSID,char*
pServer)
{
COSERVERINFO lServer = { 0,NULL,NULL,0 };
HRESULT hr;
MULTI_QI lQI = { &IID_IDispatch,NULL,0 };
CLSID lCLSID;
char x[1024];

sprintf(x,"DLLTools Creating remote object on server \"%s\", CLSID
\"%s\"\n",pServer,pCLSID);
OutputDebugString(x);

OLECHAR lServerStr[1024];
OLECHAR lCLSIDStr[1024];

MultiByteToWideChar(CP_ACP,MB_PRECOMPOSED,pCLSID,-1,lCLSIDStr,1024);
MultiByteToWideChar(CP_ACP,MB_PRECOMPOSED,pServer,-1,lServerStr,1024);
lServer.pwszName = lServerStr;

// try it as a progid first
hr = CLSIDFromProgID(lCLSIDStr,&lCLSID);

if(FAILED(hr)) {
hr = CLSIDFromString(lCLSIDStr,&lCLSID);
if(FAILED(hr)) {
sprintf(x,"DLLTools could not interpret %s as a valid ProgID or
CLSID\n",pCLSID);
OutputDebugString(x);
return NULL;
}
}
hr = CoCreateInstanceEx(lCLSID,NULL,CLSCTX_ALL,&lServer ,1,&lQI);
if(FAILED(hr)) {
sprintf(x,"DLLTools CoCreateInstanceEx failed code %x\n",hr);
OutputDebugString(x);
return NULL;
}
return (IDispatch*) lQI.pItf;
}







Erich Neuwirth wrote:
It took me long to answer.
This code solves my Problem:
It creates the server object on a remote machine
without the need for a registry entry on the client machine.


Thanks so much


Tom Ogilvy wrote:

This creates an instance of Word on the local machine from Excel 2000, US
English, Win 2K. I don't have a remote server to go against. But if
this
works here, I suspect the problem with a remote server could be with
security settings. This article might give some insights:

http://support.microsoft.com/default...b;en-us;174024
DCOM95 Frequently Asked Questions

This article basically seems like it might have been the original
source for
the code you found, but there are some differences which might be
significant. Your code makes some assumptions about early and late
binding
and the use of the constant with a word guid seems strange if your not
going
against word.

http://support.microsoft.com/default...17&Product=vbb

HOWTO: Control Server Location in a Visual Basic Client


Event though an instance of Word can be seen in the task manager (and
terminated there), I couldn't do much with the variable X. It doesn't
seem
to be the standard type of reference you get back from CreateObject. All
that said, under VBA6 (xl2000 and later), createobject has a second
argument
for servername

CreateObject(class,[servername])



-=-=-=-=-=-=-=-=-=-=-=-=-=-


This is the corrected code




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 on local machine.
Set x = CreateObjectEx("{000209FE-0000-0000-C000-000000000046}")
' x.Visible = True
Debug.Print TypeName(x)

End Sub


All times are GMT +1. The time now is 01:54 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com