Sauvegarder la description des champs d'une base de données Access dans un fichier CSV
Option Explicit
Sub DocumentAccessTableFields()
Dim dataBase As DAO.dataBase
Dim tableDefinition As DAO.tableDef
Dim tableProperty As DAO.Property, fieldProperty As DAO.Property
Dim field As DAO.field
Dim tableDefinitionString As String
Dim cptRow, cptColumn As Integer
On Error GoTo catch
cptRow = 1
cptColumn = 1
Set dataBase = OpenDatabase("AccessDataBase.mdb", False, False)
Set tableDefinition = dataBase.TableDefs("TableTest")
'Table Definition
For Each tableProperty In tableDefinition.Properties
tableDefinitionString = tableDefinitionString & tableProperty.Name & ";" & tableProperty.Value & ";"
Next tableProperty
'Fields definition
For Each field In tableDefinition.Fields
Dim fieldDescription As String
fieldDescription = field.Name & ";" & tableDefinition.Name & ";"
For Each fieldProperty In field.Properties
fieldDescription = fieldDescription & fieldProperty.Name & ";" & fieldProperty.Value & ";"
Next
'Print in the workbook
Dim textToWrite As Variant
ExportToWorkbook cptRow, cptColumn, Split(fieldDescription, ";")
cptRow = cptRow + 1
Next
Exit Sub
'Error Handler
catch:
If Err.Source = "DAO.Field" Then
fieldDescription = fieldDescription & fieldProperty.Name & ";" & "Undefined" & ";"
Resume Next
ElseIf Err.Number = "55" Then
Resume
Else: MsgBox Err.Number + Err.Description
End If
End Sub
'Print the table in the Active Excel workbook
Sub ExportToWorkbook(ByVal cptRow As Integer, ByVal cptColumn As Integer, ByVal text As Variant)
Dim i As Integer
i = 0
For i = cptColumn - 1 To UBound(text)
Cells(cptRow, cptColumn + i).Value = text(i)
Next
End Sub