'
' VisualBasic 5 introduces the "AddressOf" operator to get 
' function addresses for Windows API callbacks.
' Unfortunately, that operator is not implemented in MS Access 97.
' 
' Instead, use this code to get the address of a function
'
' Useage:
'  address = addrOf ("FunctionName")
'
' Copy this code to a module named Get_Function_Address
'
' I was not able to get this to work - 07-09-02
' GetFuncID returned a non-zero value
'
' code from 
' http://perso.wanadoo.fr/frederic.sigonneau/code/Tempos/TimerStratos.txt

 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 lpfnAddressOf As Long _
       ) _
        As Long

 
Public Function AddrOf _
       ( _
         CallbackFunctionName As String _
       ) _
         As Long
  'AddressOf operator replacement for Office97 VBA
  'Authors: Ken Getz and Michael Kaplan
  '
  'declaration of local variables
   Dim aResult As Long
   Dim CurrentVBProject As Long
   Dim strFunctionID As String
   Dim AddressOfFunction As Long
   Dim UnicodeFunctionName As String
  '
  'convert the name of the function to Unicode system
   UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)
  '
  'if the current VBProjects exists...
   If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
     '...get the function ID of the callback function, based on its
     'unicode-converted name, in order to ensure that it exists
      aResult = GetFuncID _
       ( _
         hProject:=CurrentVBProject, _
         strFunctionName:=UnicodeFunctionName, _
         strFunctionID:=strFunctionID _
       )
     'if the function exists indeed ...
       If aResult = 0 Then
         '...get a pointer to the callback function based on
         'the strFunctionID argument of the GetFuncID function
          aResult = GetAddr _
                 ( _
                   hProject:=CurrentVBProject, _
                   strFunctionID:=strFunctionID, _
                   lpfnAddressOf:=AddressOfFunction _
                 )
         'if we've got the pointer pass it to the result
         'of the function
          If aResult = 0 Then
             AddrOf = AddressOfFunction
          End If
       End If
   End If
 End Function