Visual Basic Programming Code Examples Visual Basic > Database SQL Stuff Code Examples Adding and Deleting DSNs Adding and Deleting DSNs The following routines show how to add and delete ODBC DSNs programatically. Note, further information on DSNs can be found in the following download: '----DSN Declarations-------- Option Explicit Public Enum eDBType FileBased ServerBased End Enum Public Type tDSNAttrib Type As eDBType 'FileBased (eg Access) or ServerBased (eg. SQL Server) Server As String 'Database Server Description As String 'Database description DSN As String 'The DSN Name Driver As String 'The Drive name Database As String 'Name or path of database UserID As String 'The UserID Password As String 'The User Password TrustedConnection As Boolean 'If True ignore the UserID and Password as will us NT SystemDSN As Boolean 'If True creates a system DSN, else creates a user DSN. End Type Private Const ODBC_ADD_DSN = 1 Private Const ODBC_CONFIG_DSN = 2 Private Const ODBC_REMOVE_DSN = 3 Private Const ODBC_ADD_SYS_DSN = 4 Private Const ODBC_CONFIG_SYS_DSN = 5 Private Const ODBC_REMOVE_SYS_DSN = 6 Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long Private Declare Function SQLInstallerError Lib "ODBCCP32.DLL" (ByVal iError As Long, ByVal pfErrorCode As Long, ByVal lpszErrorMsg As String, ByVal cbErrorMsgMax As Long, pcbErrorMsg As Long) As Long 'Purpose : Creates a new DSN 'Inputs : tAttributes A type containing the input parameters for the DSN. ' Look in either "C:\WINNT\Odbc.ini" or the registry under "HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI" ' for typical details. 'Outputs : Returns an empty string if successful, else returns an error message 'Notes : If TrustedConnection is set to False, then you must supply a valid UID ' and PWD (username and password), otherwise the DSN will not be created. ' When specify a username and password (i.e. when TrustedConnection = False) the ' connection details will be verified before the DSN is created. If the details ' are invalid the DSN will not be created. When using a TrustedConnection, no ' such checking is carried out before the DSN is created. 'Revisions : 'Assumptions : Public Function DSNCreate(tAttributes As tDSNAttrib) As String Const clMaxErrors As Long = 8 Dim lRet As Long, sError As String, lLen As Long, lErrorCode As Long Dim sAttributes As String, bSuccess As Boolean, lThisMessage As Long On Error Resume Next If tAttributes.Type = FileBased Then 'File based database sAttributes = "DBQ=" & tAttributes.Database & vbNullChar Else 'Server based database sAttributes = "Server=" & tAttributes.Server & vbNullChar sAttributes = sAttributes & "DATABASE=" & tAttributes.Database & vbNullChar End If 'Name of DSN sAttributes = sAttributes & "DSN=" & tAttributes.DSN & vbNullChar If Len(tAttributes.Description) Then 'Description sAttributes = sAttributes & "DESCRIPTION=" & tAttributes.Description & vbNullChar End If If tAttributes.TrustedConnection Then 'Use Windows NT Authentication '(will only validate the username and password when connection to the database) sAttributes = sAttributes & "Trusted_Connection=Yes" & vbNullChar Else 'Specify a username and password (must specify a valid username and password) If Len(tAttributes.UserID) Then sAttributes = sAttributes & "UID=" & tAttributes.UserID & vbNullChar End If If Len(tAttributes.Password) Then sAttributes = sAttributes & "PWD=" & tAttributes.Password & vbNullChar End If End If If tAttributes.SystemDSN Then 'Create a system DSN (visible to all users and services) bSuccess = SQLConfigDataSource(0&, ODBC_ADD_SYS_DSN, tAttributes.Driver, sAttributes) Else 'Create a user DSN (visible to the current users) bSuccess = SQLConfigDataSource(0&, ODBC_ADD_DSN, tAttributes.Driver, sAttributes) End If If bSuccess = False Then 'Failed to create DSN, return error message sError = String(255, 0) For lThisMessage = 1 To clMaxErrors lRet = SQLInstallerError(lThisMessage, lErrorCode, sError, 255&, lLen) If lRet = 0 Then 'Add error messages together DSNCreate = DSNCreate & Left(sError, lLen) & vbNewLine Else 'No more error messages Exit For End If Next Else 'Success DSNCreate = "" End If End Function 'Purpose : Deletes an existing DSN 'Inputs : tAttributes A type containing the input parameters of the DSN. ' Look in either "C:\WINNT\Odbc.ini" or the registry under "HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI" ' for typical details. ' [bSystemDSN] If True deletes as system DSN, else deletes a user DSN. 'Outputs : Returns True if successful 'Notes : 'Revisions : 'Assumptions : Public Function DSNDelete(sDSN As String, sDriver As String, Optional bSystemDSN As Boolean = False) As Boolean Dim lRet As Long Dim sAttributes As String On Error Resume Next sAttributes = "DSN=" & sDSN & vbNullChar If bSystemDSN Then DSNDelete = SQLConfigDataSource(0&, ODBC_REMOVE_DSN, sDriver, sAttributes) Else DSNDelete = SQLConfigDataSource(0&, ODBC_REMOVE_SYS_DSN, sDriver, sAttributes) End If End Function 'Demonstration routine Sub Test() Dim tDSNDetails As tDSNAttrib, sError As String '---Add an Access DSN With tDSNDetails .Database = "C:\vbusers.mdb" .Driver = "Microsoft Access Driver (*.mdb)" .Password = "" .UserID = "Admin" .DSN = "TestDSN" .Description = "A Test Database" .Type = FileBased End With sError = DSNCreate(tDSNDetails) If Len(sError) = 0 Then MsgBox "Created user DSN" 'Delete the new DSN If DSNDelete(tDSNDetails.DSN, tDSNDetails.Driver) Then MsgBox "Deleted New DSN" Else MsgBox "Failed to Delete New DSN" End If Else MsgBox "Failed to Create DSN... " & vbNewline & sError End If '---Add an SQL Server DSN With tDSNDetails .Database = "Pubs" .Driver = "SQL Server" .Server = "MyServer" .TrustedConnection = True 'Use NT authentication .Password = "" .UserID = "" .DSN = "TestDSN2" .Description = "A Test Database2" .Type = ServerBased .SystemDSN = True 'Create a System DSN End With sError = DSNCreate(tDSNDetails) If Len(sError) = 0 Then MsgBox "Created system DSN" 'Delete the new DSN If DSNDelete(tDSNDetails.DSN, tDSNDetails.Driver) Then MsgBox "Deleted New DSN" Else MsgBox "Failed to Delete New DSN" End If Else MsgBox "Failed to Create DSN... " & vbNewline & sError End If End Sub