[VBA] Access par Excel via DAO ou ADO

Dev
1

Je cherche depuis ce matin comment récupérer la liste des tables d’un fichier Access 2000 depuis Excel 2000 en vba. J’ai parcouru tout MSDN sans succès, ca ne parle que de Excel 2003 et .NET alors que je dois bosser avec les versions 2000.

Voici le bout de code que j’ai testé :

[codebox]
Dim intTblCnt As Integer, intTblFlds As Integer
Dim strTbl As String
Dim rsC As ADODB.Recordset
Dim intColCnt As Integer, intColFlds As Integer
Dim strCol As String
Dim t As Integer, c As Integer, f As Integer

Set Cnx = New ADODB.Connection
’Définition du pilote de connexion
Cnx.Provider = “'Microsoft.Jet.Oledb.4.0”
'Définition de la chaîne de connexion
Cnx.ConnectionString = ThisWorkbook.Path & “” & NomFichierAccess
’Ouverture de la base de données
Cnx.Open

Set Rs = Cnx.OpenSchema(adSchemaTables)

intTblCnt = Rs.RecordCount
intTblFlds = Rs.Fields.Count
Debug.Print "Tables: " & intTblCnt
For t = 1 To intTblCnt
strTbl = Rs.Fields(“TABLE_NAME”).Value
Debug.Print vbTab & “Table #” & t & ": " & strTbl
Debug.Print vbTab & "--------------------"
For f = 0 To intTblFlds - 1
Debug.Print vbTab & Rs.Fields(f).Name & _
vbTab & Rs.Fields(f).Value
Next
Debug.Print "--------------------"
Rs.MoveNext
Next

Rs.Close
Cnx.Close
Set Rs = Nothing
Set Cnx = Nothing[/codebox]

Il arrive bien à se connecter (en tout cas il ne met pas d’erreurs) mais intTblCnt est égal à -1.

Si quelqu’un à une suggestion avant que j’aille me jeter du 7ème étage…

2

Je me répond à moi même, j’ai trouvé une solution en DAO :

[codebox]
’---------------------------------------------------------------------------------------
’ Function FichiersAccess
’---------------------------------------------------------------------------------------
’
’---------------------------------------------------------------------------------------
'
Public Function ListeFichiersAccess() As Collection
Dim Fso As FileSystemObject
Dim Dossier As Folder
Dim Fichiers As Files
Dim Fichier As file

Set ListeFichiersAccess = New Collection
Set Fso = New FileSystemObject
Set Dossier = Fso.GetFolder(ThisWorkbook.Path)
Set Fichiers = Dossier.Files

For Each Fichier In Fichiers
If UCase(right(CStr(Fichier.Name), 3)) = UCase(“mdb”) Then
ListeFichiersAccess.Add Fichier.Name
End If
Next

Set Fichiers = Nothing
Set Dossier = Nothing
Set Fso = Nothing
End Function

‘---------------------------------------------------------------------------------------
’ Function ListeTables
’---------------------------------------------------------------------------------------
’
’---------------------------------------------------------------------------------------
'
Public Function ListeTables(NomFichierAccess As String) As Collection
Dim i As Long
Dim Db As Database

Set ListeTables = New Collection
Set Db = DBEngine.OpenDatabase(ThisWorkbook.Path & “” & NomFichierAccess)

For i = 0 To Db.TableDefs.Count - 1
If Left(Db.TableDefs(i).Name, 4) <> “MSys” Then
ListeTables.Add Db.TableDefs(i).Name
End If
Next i

Db.Close
Set Db = Nothing

End Function

‘---------------------------------------------------------------------------------------
’ Function InitLibelles
’---------------------------------------------------------------------------------------
’
’---------------------------------------------------------------------------------------
'
Public Function GetLibelles(NomFichierAccess As String, NomTable As String) As Ligne
Dim i As Long
Dim Db As Database
Dim Fct As BStandard

Set GetLibelles = New Ligne
Set Db = DBEngine.OpenDatabase(ThisWorkbook.Path & “” & NomFichierAccess)
Set Fct = New BStandard

For i = 0 To Db.TableDefs(NomTable).Fields.Count - 1
GetLibelles.Value(Fct.F_S_ColNumber2String(i + 1)) = _
Db.TableDefs(NomTable).Fields(i).Name
Next i

Db.Close
Set Db = Nothing
Set Fct = Nothing
End Function
[/codebox]

Si quelqu’un a une solution en ADO je suis preneur.

3

si tu veux recuperer la liste des tables, tu peux mettre ceci :

Set Cnx = New ADODB.Connection Cnx.Provider = "Microsoft.Jet.Oledb.4.0" Cnx.ConnectionString = ThisWorkbook.Path & "\" & NomFichierAccess Cnx.Open Set Rs = Cnx.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE")) Do Until Rs.EOF If UCase(Left(Rs.Table_name, 4)) <> "MSYS" Then If UCase(Left(Rs.Table_name, 11)) <> "SWITCHBOARD" Then Debug.Print Rs.Table_name End If End If Rs.MoveNext Loop Rs.Close Cnx.Close Set Rs = Nothing Set Cnx = Nothing