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