Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Type CONSERVEVERINFO
dwReserved1 As Long
pwszName As Long
pAuthInfo As Long
dwReserved2 As Long
End Type
Private Type MULTI_QI
piid As Long
pItf As Object
hr As Long
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_LOCAL_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 lpszProgId 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 CONSERVEVERINFO, 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 CONSERVEVERINFO
Dim context As Long
Dim mqi As MULTI_QI
mqi.piid = GlobalAlloc(GMEM_FIXED, 16)
hr = IIDFromString(StrConv(IID_IDispatch, vbUnicode), mqi.piid)
If ((Left(Class, 1) = "{") And (Right(Class, 1) = "}") And (Len(Class) = 38)) Then
hr = CLSIDFromString(StrConv(Class, vbUnicode), rclsID)
If hr <> 0 Then Err.Raise hr
Else
hr = CLSIDFromProgID(StrConv(Class, vbUnicode), rclsID)
If hr <> 0 Then Err.Raise hr
End If
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
hr = coCreateInstanceEx(rclsID, 0, context, ServerInfo, 1, mqi) 'Error
If hr <> 0 Then Err.Raise hr
GlobalFree mqi.pItf
Set CreateObjectEX = mqi.pItf
End Function
i get the error the above mentioned line
i hope rclsid is not returned
Please try it out and reply me
With Love
Prakash
