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.
