VB and VBA Users Source Code: Returning a list of DSNs and their driver type
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Returning a list of DSNs and their driver type
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, September 26, 2001
Hits:
706
Category:
Windows API
Article:
The following code demonstrates how to return a list of the DSNs (Data Source Names) available on a specific machine. 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 Integer Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" (env As Long) As Integer Private Const SQL_SUCCESS As Long = 0 Private Const SQL_FETCH_NEXT As Long = 1 'Purpose : Returns an array of DSNs given the type of DSN to search for. 'Inputs : asMatchingDSNs See outputs. ' [sDSNType] If unspecified returns all the system DSNs else ' returns a specific DSN eg "Sybase System 11" 'Outputs : Returns a count of the matching DSNs or -1 if an error occured. ' asMatchingDSNs A 2d one based string array of the form: ' asMatchingDSNs(1 to 2, 1 to Number of matching DSNs) ' with asMatchingDSNs(1,1) containing the DSN type (eg Access or SQL Server) ' and asMatchingDSNs(2,1) containing the DSN name. 'Author : Andrew Baker 'Date : 19/Sep/2001 15:50 Function DSNListMatching(asMatchingDSNs() As String, Optional ByVal sDSNType As String = "All") As Long Const clMaxDSN As Long = 1000 Dim lRet As Integer, sDSNItem As String * 1024, sDRVItem As String * 1024 Dim sDSN As String, sDRV As String, bReturnType As Boolean Dim iDSNLen As Integer, iDRVLen As Integer, lhwnEnv As Long 'handle to the environment On Error GoTo ErrFailed 'Create buffer to hold DSNs ReDim asMatchingDSNs(1 To 2, 1 To clMaxDSN) sDSNType = UCase$(sDSNType) 'Make it case insensative If SQLAllocEnv(lhwnEnv) <> -1 Then Do Until lRet <> SQL_SUCCESS lRet = SQLDataSources(lhwnEnv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen) sDSN = Left$(sDSNItem, iDSNLen) sDRV = Left$(sDRVItem, iDRVLen) If sDSNType = UCase$(sDRV) Or (sDSNType = "ALL") Then 'Store this DSN in the output array DSNListMatching = DSNListMatching + 1 asMatchingDSNs(1, DSNListMatching) = sDRV asMatchingDSNs(2, DSNListMatching) = sDSN End If Loop If DSNListMatching Then 'Resize the result array ReDim Preserve asMatchingDSNs(1 To 2, 1 To DSNListMatching) Else 'No Matching DSNs where found, clear the array Erase asMatchingDSNs End If End If Exit Function ErrFailed: Debug.Print "Error in DSNListMatching: " & Err.Description DSNListMatching = -1 End Function 'Returns all the Sybase and Access DSNs on the local machine Sub Demonstration() Dim lCountDSN As Long, asDSN() As String, lThisDSN As Long lCountDSN = DSNListMatching(asDSN, "Sybase System 11") Debug.Print "SYBASE DSNs:" For lThisDSN = 1 To lCountDSN Debug.Print lThisDSN & "." & vbNewLine & "DSN Type: " & asDSN(1, lThisDSN) Debug.Print "DSN Name: " & asDSN(2, lThisDSN) Debug.Print "---------------------------" Next lCountDSN = DSNListMatching(asDSN, "Microsoft Access Driver (*.mdb)") Debug.Print "ACCESS DSNs:" For lThisDSN = 1 To lCountDSN Debug.Print lThisDSN & "." & vbNewLine & "DSN Type: " & asDSN(1, lThisDSN) Debug.Print "DSN Name: " & asDSN(2, lThisDSN) Debug.Print "---------------------------" Next End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
