Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleCreate a DSN in code using an ActiveX DLL
KeywordsDSN, database, ActiveX DLL
CategoriesDatabase, ActiveX
 
Thanks to Craig.

Use the SQLConfigDataSource routine in odbccp32.dll. This zip file contains the class code for the ActiveX DLL.

This example makes a couple of API calls so it's best to check if your system is compatible and if you have those dll's on your system and that they 32 bit. This example also uses the Common Dialog control (SP3). It doesn't make use of any major features of the Common Dialog so a normal Common Dialog can be used if the current reference causes an error.

 
Public Property Let ODBC_DSN_NAME(ByVal sName As String)
   m_ODBC_DSN_Name = sName
End Property

Public Property Let ODBC_DRIVER_NAME(ByVal sDriver As _
    String)
   m_ODBC_Driver_Name = sDriver
End Property

Public Property Let ODBC_DATA_SOURCE(ByVal sDBFile As _
    String)
   m_ODBC_Data_Source = sDBFile
End Property

Friend Function ExecuteDSNCommand( _
   ByVal dsnType As DSNTypeEnum, _
   ByVal sDSN_Name As String, _
   ByVal sDriver As String, _
   ByVal sDBFile As String, _
   ByVal eAction As ACTION _
   ) As Boolean

On Error GoTo ExecuteDSNCommandError

   Const PROCEDURENAME  As String = "ExecuteDSNCommand"
   Dim sAttributes      As String
   Dim sDBQ             As String
   Dim sMessage         As String
   Dim lRetVal          As Long
   Dim lErrNo           As Long

   If sDSN_Name = "" Then
      sDSN_Name = m_ODBC_DSN_Name
   End If

   If sDriver = "" Then
      sDriver = m_ODBC_Driver_Name
   End If

   If sDBFile = "" Then
      sDBFile = m_ODBC_Data_Source
   End If

   sDBQ = mf_DSNRegistryEntry(dsnType, sDSN_Name)

   If (sDBQ = "" And (eAction = ODBC_ADD_DSN Or eAction = _
       ODBC_ADD_SYS_DSN)) _
   Or _
      (sDBQ <> "" And (eAction = ODBC_REMOVE_DSN Or eAction _
          = ODBC_CONFIGURE_DSN _
                  Or eAction = ODBC_CONFIG_SYS_DSN Or _
                      eAction = ODBC_REMOVE_SYS_DSN)) Then

      If Len(Dir(sDBFile)) = 0 Then
         Err.Raise mc_DataFileNotFoundError, PROCEDURENAME, _
             "Data file doesn't exist!"
      Else
         sAttributes = "DSN=" & sDSN_Name & vbNullChar & _
             "DBQ=" & sDBFile & vbNullChar
         lRetVal = SQLConfigDataSource(0&, eAction, _
             sDriver, sAttributes)
      End If
   Else
      If eAction = ODBC_ADD_DSN Or _
         eAction = ODBC_ADD_SYS_DSN Then

         sMessage = " already exists!"
         lErrNo = mc_DataFileExistsError
      Else
         sMessage = " doesn't exist!"
         lErrNo = mc_DataFileNotFoundError
      End If

      Err.Raise mc_DataFileExistsError, PROCEDURENAME, _
          "DSN: " & sDSN_Name & sMessage
   End If

   ExecuteDSNCommand = True

ExecuteDSNCommandExit:
   Exit Function

ExecuteDSNCommandError:
   ExecuteDSNCommand = False

   With m_Error
      .ETDescription = Err.Description
      .ETNumber = Err.Number
      .ETSource = Err.Source
   End With

   Resume ExecuteDSNCommandExit
End Function

Public Sub CreateDSN( _
   Optional ByVal dsnType As DSNTypeEnum = UserDSN, _
   Optional ByVal sDSN_Name As String = "", _
   Optional ByVal sDriver As String = "", _
   Optional ByVal sDataSource As String = "" _
   )

   Dim eAction As ACTION

   If dsnType = SystemDSN Then
      eAction = ODBC_ADD_SYS_DSN
   Else
      eAction = ODBC_ADD_DSN
   End If

   If Not ExecuteDSNCommand(dsnType, sDSN_Name, sDriver, _
       sDataSource, eAction) Then
      With m_Error
         If .ETNumber <> 0 Then
            Err.Raise .ETNumber, .ETSource, .ETDescription
         End If
      End With
   End If
End Sub

Public Sub DeleteDSN( _
   Optional ByVal dsnType As DSNTypeEnum = UserDSN, _
   Optional ByVal sDSN_Name As String = "", _
   Optional ByVal sDriver As String = "", _
   Optional ByVal sDataSource As String = "" _
   )

   Dim eAction As ACTION

   If dsnType = SystemDSN Then
      eAction = ODBC_REMOVE_SYS_DSN
   Else
      eAction = ODBC_REMOVE_DSN
   End If

   If Not ExecuteDSNCommand(dsnType, sDSN_Name, sDriver, _
       sDataSource, eAction) Then
      With m_Error
         If .ETNumber <> 0 Then
            Err.Raise .ETNumber, .ETSource, .ETDescription
         End If
      End With
   End If

End Sub

Public Sub ConfigureDSN( _
   Optional ByVal dsnType As DSNTypeEnum = UserDSN, _
   Optional ByVal sDSN_Name As String = "", _
   Optional ByVal sDriver As String = "", _
   Optional ByVal sDataSource As String = "" _
   )

   Dim eAction As ACTION

   If dsnType = SystemDSN Then
      eAction = ODBC_CONFIG_SYS_DSN
   Else
      eAction = ODBC_CONFIGURE_DSN
   End If

   If Not ExecuteDSNCommand(dsnType, sDSN_Name, sDriver, _
       sDataSource, eAction) Then
      With m_Error
         If .ETNumber <> 0 Then
            Err.Raise .ETNumber, .ETSource, .ETDescription
         End If
      End With
   End If
End Sub

Private Function mf_DSNRegistryEntry( _
   DSN_TYPE As DSNTypeEnum, _
   sDSN As String _
   ) As String

   Dim lHKEY      As Long
   Dim sDBQ       As String
   Dim hKey       As Long
   Dim sRegValue  As String
   Dim lValueType As Long

   mf_DSNRegistryEntry = ""

   If DSN_TYPE = SystemDSN Then
      lHKEY = HKEY_LOCAL_MACHINE
   ElseIf DSN_TYPE = UserDSN Then
      lHKEY = HKEY_CURRENT_USER
   End If

   If RegOpenKeyEx(lHKEY, _
      "Software\ODBC\ODBC.INI\" & sDSN, _
      0, _
      KEY_ALL_ACCESS, hKey _
      ) = 0 Then

      sRegValue = String(1024, 0)

      If RegQueryValueEx(hKey, _
         "DBQ", _
         0, _
         lValueType, _
         sRegValue, _
         Len(sRegValue) _
         ) = 0 Then

         If lValueType = REG_SZ Then
            sDBQ = Left(sRegValue, InStr(sRegValue, _
                vbNullChar) - 1)
         End If
      End If

      RegCloseKey hKey
      mf_DSNRegistryEntry = sDBQ
   End If
End Function
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated