Wednesday, December 13, 2023

Excel VBA: Steps to create Windows ODBC DSN to access FileMaker Pro data

Create Windows ODBC DSN to access FileMaker Pro


Accessing data from FileMaker into Excel


FileMaker database file can be accessed via ODBC/JDBC method, once following points are taken care:

  • User has proper access via ODBC/JDBC
  • Data sharing for FileMaker database file has been enabled through FileMaker Server Advanced (via FileMaker Server Admin Console) or FileMaker Pro host application
  • FileMaker database file to be accessed by ODBC/JDBC is properly hosted and available

Next step involves creation of Windows ODBC DSN for FileMaker database file. We can use below code to create the FileMaker ODBC DSN at runtime and access FileMaker Pro data through VBA code into Excel. This VBA code can be implemented to pull data from FileMaker Pro database file to any of Microsoft Office products for e.g. Excel.

Option Explicit

Private Declare Function SQLDataSources Lib "odbc32.dll" (ByVal hEnv As Long, ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, pcbDSN As Integer, ByVal szDescription As String, ByVal cbDescriptionMax As Integer, pcbDescription As Integer) As Long

Private Declare Function SQLAllocHandle Lib "odbc32.dll" (ByVal HandleType As Integer, ByVal InputHandle As Long, OutputHandlePtr As Long) As Long

Private Declare Function SQLSetEnvAttr Lib "odbc32.dll" (ByVal EnvironmentHandle As Long, ByVal dwAttribute As Long, ByVal ValuePtr As Long, ByVal StringLen As Long) As Long

Private Declare Function SQLFreeHandle Lib "odbc32.dll" (ByVal HandleType As Integer, ByVal Handle As Long) As Long


Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal _
   cbData As Long) As Long

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias _
   "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   phkResult As Long) As Long
 
Public Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias _
    "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias _
    "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Const FMP_DATADIRECT_DRIVER_NAME As String = "DataDirect 32-BIT SequeLink 5.4"
Public Const FMP_ODBC_DRIVER_NAME As String = "FileMaker ODBC"

Public Const FMP_DATADIRECT_DRIVER_DLL As String = "C:\Program Files\DataDirect\slodbc54\ivslk19.dll"


Public Const REG_SZ = 1    'Constant for a string variable type.
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003
Private Const DSN_LEN As Long = 32
Private Const DESC_LENGTH As Long = 128
Private Const FoundOk As Long = 0
Private Const GetNext As Long = 1
Private Const Null_HANDLE As Long = 0
Private Const HANDLE_ENV As Long = 1
Private Const ATTR_ODBC_VERSION As Long = 200
Private Const OV_ODBC3 As Long = 3
Private Const IS_INTEGER As Long = (-6)
Public Const FMP_ODBC_JDBC_PORT As String = "2399"

Public Const SERVERNAME As String = "Specify here FMP Server host name"


'Create an FMP ODBC DSN for any FMP database file at runtime
Public Sub Create_User_DSN(DataSourceName As String, Description As String, ServerDataSource As String, DriverName As String)
  
    'DataSourceName --> Name of DSN
    'Description --> DSN description in brief. Can be kept same as DSN Name
    'ServerDataSource --> FMP database file name for which DSN need to be created
  
    Dim DistinguishedName As String
    Dim lResult As Long
    Dim hKeyHandle As Long
 
    Dim AutoDetectEncoding As String
    Dim Database  As String
    Dim Driver  As String
    Dim MultiByteEncoding  As String
    Dim Port  As String
    Dim QueryLog_On  As String
    Dim QueryLogFile  As String
    Dim QueryLogTime  As String
    Dim Server As String
    Dim Host As String
    Dim UseLDAP As String
    Dim sMsg As String
 
    If DSNExists(DataSourceName) Then
        If Delete_User_DSN(DataSourceName) = False Then Exit Sub
    End If
  
    If UCase(DriverName) = UCase(FMP_ODBC_DRIVER_NAME) Then

        'Setting for FileMaker ODBC driver for FMP Server 11. Similarly can be done for version 12.
        'FileMaker ODBC Driver (32-bit)
      
        AutoDetectEncoding = "No"
        Database = ServerDataSource
        Driver = DriverName
        MultiByteEncoding = "UTF-8"
        Port = ""
        QueryLog_On = ""
        QueryLogFile = ""
        QueryLogTime = ""
        Server = SERVERNAME
      
      
        lResult = RegCreateKey(HKEY_CURRENT_USER, "SOFTWARE\ODBC\ODBC.INI\" & _
             DataSourceName, hKeyHandle)
           
        'Set the values of the new DSN key.
      
        lResult = RegSetValueEx(hKeyHandle, "AutoDetectEncoding", 0&, REG_SZ, _
           ByVal AutoDetectEncoding, Len(AutoDetectEncoding))
        lResult = RegSetValueEx(hKeyHandle, "Database", 0&, REG_SZ, _
           ByVal Database, Len(Database))
        lResult = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, _
           ByVal Description, Len(Description))
        lResult = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, _
           ByVal Driver, Len(Driver))
        lResult = RegSetValueEx(hKeyHandle, "MultiByteEncoding", 0&, REG_SZ, _
           ByVal MultiByteEncoding, Len(MultiByteEncoding))
        lResult = RegSetValueEx(hKeyHandle, "Port", 0&, REG_SZ, _
           ByVal Port, Len(Port))
        lResult = RegSetValueEx(hKeyHandle, "QueryLog_On", 0&, REG_SZ, _
           ByVal QueryLog_On, Len(QueryLog_On))
        lResult = RegSetValueEx(hKeyHandle, "QueryLogFile", 0&, REG_SZ, _
           ByVal QueryLogFile, Len(QueryLogFile))
        lResult = RegSetValueEx(hKeyHandle, "QueryLogTime", 0&, REG_SZ, _
           ByVal QueryLogTime, Len(QueryLogTime))
        lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, _
           ByVal Server, Len(Server))
      
        'Close the new DSN key.
      
        lResult = RegCloseKey(hKeyHandle)
      
        'Open ODBC Data Sources key to list the new DSN in the ODBC Manager.
        'Specify the new value.
        'Close the key.
      
        lResult = RegCreateKey(HKEY_CURRENT_USER, _
           "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKeyHandle)
        lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, _
           ByVal Driver, Len(Driver))
        lResult = RegCloseKey(hKeyHandle)

    ElseIf UCase(DriverName) = UCase(FMP_DATADIRECT_DRIVER_NAME) Then

  
        'Setting for DataDirect SequeLink driver for FMP Server 8 and below
      
        DistinguishedName = ""
        Driver = FMP_DATADIRECT_DRIVER_DLL
        Host = SERVERNAME
        Port = FMP_ODBC_JDBC_PORT
        UseLDAP = "0"
      
        'Create the new DSN key.
      
        lResult = RegCreateKey(HKEY_CURRENT_USER, "SOFTWARE\ODBC\ODBC.INI\" & _
             DataSourceName, hKeyHandle)
           
        'Set the values of the new DSN key.
      
        lResult = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, _
           ByVal Description, Len(Description))
        lResult = RegSetValueEx(hKeyHandle, "DistinguishedName", 0&, REG_SZ, _
           ByVal DistinguishedName, Len(DistinguishedName))
        lResult = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, _
           ByVal Driver, Len(Driver))
        lResult = RegSetValueEx(hKeyHandle, "Host", 0&, REG_SZ, _
           ByVal Host, Len(Host))
        lResult = RegSetValueEx(hKeyHandle, "Port", 0&, REG_SZ, _
           ByVal Port, Len(Port))
        lResult = RegSetValueEx(hKeyHandle, "ServerDataSource", 0&, REG_SZ, _
           ByVal ServerDataSource, Len(ServerDataSource))
        lResult = RegSetValueEx(hKeyHandle, "UseLDAP", 0&, REG_SZ, _
           ByVal UseLDAP, Len(UseLDAP))
      
        'Close the new DSN key.
      
        lResult = RegCloseKey(hKeyHandle)
      
        'Open ODBC Data Sources key to list the new DSN in the ODBC Manager.
        'Specify the new value.
        'Close the key.
      
        lResult = RegCreateKey(HKEY_CURRENT_USER, _
           "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKeyHandle)
        lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, _
           ByVal DriverName, Len(DriverName))
        lResult = RegCloseKey(hKeyHandle)
    End If
End Sub


'To check if FMP ODBC DSN exist or not
Public Function DSNExists(DSN As String) As Boolean

 Dim hEnv As Long
 Dim sServer As String
 Dim sDriver As String
 Dim nSvrLen As Integer
 Dim nDvrLen As Integer

 If SQLAllocHandle(HANDLE_ENV, _
     Null_HANDLE, hEnv) <> 0 Then
  
     If SQLSetEnvAttr(hEnv, _
         ATTR_ODBC_VERSION, _
         OV_ODBC3, _
         IS_INTEGER) <> 0 Then
      
         sServer = Space$(DSN_LEN)
         sDriver = Space$(DESC_LENGTH)
      
         Do While SQLDataSources(hEnv, _
             GetNext, _
             sServer, _
             DSN_LEN, _
             nSvrLen, _
             sDriver, _
             DESC_LENGTH, _
             nDvrLen) = FoundOk
             If Trim(DSN) = Trim(Left$(sServer, nSvrLen)) Then
                DSNExists = True
                Exit Do
             End If
             sServer = Space$(DSN_LEN)
         Loop
     End If
     Call SQLFreeHandle(HANDLE_ENV, hEnv)
 End If


End Function


'To delete existing FMP ODBC DSN
Public Function Delete_User_DSN(DataSourceName As String) As Boolean
    Dim Result As Long

    Delete_User_DSN = False
  
    RegOpenKey HKEY_CURRENT_USER, DataSourceName, Result
    RegDeleteKey Result, DataSourceName
    RegCloseKey Result
  
    Delete_User_DSN = True
  
End Function


'Connection string needed for ADODB Connection object
Public Function ConnString(DSN_name As String, DriverName As String) As String
    Dim UID As String
    Dim PWD As String
  
    UID = "Specify user name"
    PWD = "Specify password"
  
    If UCase(DriverName) = UCase(FMP_ODBC_DRIVER_NAME) Then
        'For FileMaker ODBC driver for FMP Server 11
        ConnString = "Provider=MSDASQL.1;Password=" & PWD & ";Persist Security Info=True;User ID=" & UID & ";Data Source=" & DSN_name & ";"
      
    Else
        'For DataDirect SequeLink driver for FMP Server 8 and below
        ConnString = "DSN=" & DSN_name & "; UID=" & UID & "; PWD=" & PWD
      
    End If
End Function

Hope this article was helpful to fulfill your task in accessing FileMaker Pro data into Excel or any other Microsoft Office products using VBA code/script for dynamic ODBC DSN.

No comments:

Post a Comment

Popular Posts 😊