ODBC information from Excel

[J. Freed]

I have an application that can extract ODBC information from an mdb using the
MSysObjects table. I need to do the same for Excel; is there an analogous
place in Excel where that information might be stored and how can I extract
it using Access/VBA? TIA.....

 

[Stefan Hoffmann]

hi J.,

I have an application that can extract ODBC information from an mdb using the
MSysObjects table. I need to do the same for Excel; is there an analogous
place in Excel where that information might be stored and how can I extract
it using Access/VBA? TIA.....

Excel automation works for me. ADOX may work also, but I've never used
it with Excel.


mfG
--> stefan <--

 

[ceesdatabase]

Hello,

You can find some ODBC info in the menu <data>, option <import external data>,
suboption <new database query>. Maybe the menu names are a bit different,
but a only have a duth version of Excel. I hope this is what you need. Also
included an example of getting data with ADODB.

************************************************************
Sub dummyNameProcedure()
Dim objConnection 'ODBC connection object
Dim cmdConnection 'Command object
Dim objRecordset 'Recordset with result of query which is
located in the mdb file
Dim someVariable as String

On Error GoTo Error_dummyNameProcedure

someVariable = InputBox("Give some entry")

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Open "FILEDSN=name.dsn", "", "" ' or objConnection.Open
"name", "", ""

Set cmdConnection = CreateObject("ADODB.Command")

'Declare some parameter if needed
With cmdConnection
.Parameters.Append .CreateParameter("@vcParameter", adVarChar,
adParamInput, 6)
End With

cmdConnection("@vcParameter") = someVariable

'Get data
With cmdConnection
.ActiveConnection = objConnection
.CommandText = "queryname" 'located in the mdb file
.CommandType = adCmdStoredProc
.Execute
End With

Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.Open cmdConnection, , adOpenKeyset

Exit Sub

Error_dummyNameProcedure:

If Err = -2147467259 Then
MsgBox ("Problems with your ODBC connection")
Else
MsgBox ("Error " & Err & "(" & Err.Description & ") has occurred in
<dummyNameProcedure> !"), vbCritical
End If

End Sub

**********************************************************

 

[Stefan Hoffmann]

hi,

You can find some ODBC info in the menu <data>, option <import external data>,
suboption <new database query>. Maybe the menu names are a bit different,
but a only have a duth version of Excel. I hope this is what you need. Also
included an example of getting data with ADODB.

I think the OP meant with "ODBC information" information about the
catalog and the schemata within. Afaik you don't get that with ADODB.


mfG
--> stefan <--

 

[ceesdatabase]

Maybe this code will solve the problem.

'API Constants
Private Const SQL_SUCCESS As Long = 0
Private Const SQL_FETCH_NEXT As Long = 1

'APIs
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

'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*
' Routine: EnumerateDSNs
' Description: Fills the cb (either ComboBox or ListBox) with
' a list of ODBC DSNs
' Parameters: cb (required) - either ComboBox or ListBox to fill
' sDriver (optional) - specific DNS type filter
' (i.e. 'SQL Server')
' Created by: Serge Baranovsky
' Date-Time: 6/17/99 11:15:53 AM
' Last modification:
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*
Public Sub EnumerateDSNs(cb As Control, Optional sDriver As String = "" )
Dim nRC As Integer
Dim sDSNItem As String * 1024
Dim sDRVItem As String * 1024
Dim sDSN As String
Dim sDRV As String
Dim nDSNLen As Integer
Dim nDRVLen As Integer
Dim lHenv As Long 'handle to the environment
Dim bFilter As Boolean

On Error Resume Next

If sDriver <> "" Then bFilter = True

'get the DSNs
If SQLAllocEnv(lHenv) <> -1 Then

Do Until nRC <> SQL_SUCCESS

sDSNItem = Space(1024)
sDRVItem = Space(1024)
nRC = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, _
nDSNLen, sDRVItem, 1024, nDRVLen)

sDSN = Left(sDSNItem, nDSNLen)
sDRV = Left(sDRVItem, nDRVLen)

If sDSN <> Space(nDSNLen) Then

If bFilter Then

If sDRV = sDriver Then cb.AddItem sDSN

Else

cb.AddItem sDSN

End If

End If

Loop

End If

End Sub