Author Topic: Resolve path and dwg list  (Read 2865 times)

0 Members and 1 Guest are viewing this topic.

Bryco

  • Water Moccasin
  • Posts: 1850
Re: Resolve path and dwg list
« Reply #15 on: October 23, 2006, 11:08:15 PM »
Oops 2000i is vb6.
Perhaps someone can verify there is no problem w/ vb6.  It works for me.

Here is the 2000 stuff to add
Code: [Select]

'for 2000

Private Declare Function GetCurrentVbaProject _
 Lib "vba332.dll" Alias "EbGetExecutingProj" _
 (hProject As Long) As Long
Private Declare Function GetFuncID _
 Lib "vba332.dll" Alias "TipGetFunctionId" _
 (ByVal hProject As Long, ByVal strFunctionName As String, _
 ByRef strFunctionId As String) As Long
Private Declare Function GetAddr _
 Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
 (ByVal hProject As Long, ByVal strFunctionId As String, _
 ByRef lpfn As Long) As Long

'for 2000


In  the functiion                        Public Function BrowseForFolderByPIDL
Replace                                .lpfn = FARPROC(AddressOf BrowseCallbackProc)
with                                       .lpfn = FARPROC(AddrOf("BrowseCallbackProc")) '''''''''2000

Public Function AddrOf(strFuncName As String) As Long
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
   
    Const NO_ERROR = 0
   
    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
   
    ' Get the current VBA project
    ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
    ' so now we just check the project handle when the function returns.
    Call GetCurrentVbaProject(hProject)
   
    ' Make sure we got a project handle... we always should, but you never know!
    If hProject <> 0 Then
        ' Get the VBA function ID (whatever that is!)
        lngResult = GetFuncID( _
         hProject, strFuncNameUnicode, strID)
       
        ' We have to check this because we GPF if we try to get a function pointer
        ' of a non-existent function.
        If lngResult = NO_ERROR Then
            ' Get the function pointer.
            lngResult = GetAddr(hProject, strID, lpfn)
           
            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
   
End Function