Comment extraire le design de la table en feuille Excel?

Question

Je veux la colonne et le type de données d'une table dans le formulaire d'accès VBA ms

comment le faire facilement?

Answer 1

pour cette solution:

Option Explicit 

Public Sub ExportTableDesign() 
    Const strFileName_c As String = "testFldOutput.txt" 
    Dim strFullPath As String 
    Dim db As DAO.Database 
    Dim tdf As DAO.TableDef 
    Dim strTblName As String 
    Dim fld As DAO.Field 
    Dim strm As ADODB.Stream 
    Set db = Access.CurrentDb 
    strFullPath = Environ("USERPROFILE") & "\DeskTop\" & strFileName_c 
    Do 
     strTblName = InputBox("Please enter name of table to extract:", "Enter Table Name", strTblName) 
     If LenB(strTblName) = 0& Then Exit Sub 
     If TableExists(strTblName) Then 
      Set tdf = db.TableDefs(strTblName) 
      Exit Do 
     End If 
     MsgBox "Can not find table: " & strTblName, vbExclamation 
    Loop 
    Set strm = New ADODB.Stream 
    With strm 
     .Open 
     .LineSeparator = adCRLF 
     .WriteText "Field Name" & vbTab & "Data Type", adWriteLine 
     For Each fld In tdf.Fields 
      .WriteText fld.name & vbTab & TypeToString(fld.Type), adWriteLine 
     Next 
     .SaveToFile strFullPath, adSaveCreateOverWrite 
    End With 
    db.Close 
    Shell "Excel.exe " & strFullPath & "", vbMaximizedFocus 
End Sub 

Private Function TypeToString(ByVal typeValue As DAO.DataTypeEnum) As String 
    Dim strRtnVal As String 
    Select Case typeValue 
    Case dbBigInt: strRtnVal = "Big Integer" 
    Case dbBinary: strRtnVal = "Binary" 
    Case dbBoolean: strRtnVal = "Boolean" 
    Case dbByte: strRtnVal = "Byte" 
    Case dbChar: strRtnVal = "Char" 
    Case dbCurrency: strRtnVal = "Currency" 
    Case dbDate: strRtnVal = "Date/Time" 
    Case dbDecimal: strRtnVal = "Decimal" 
    Case dbDouble: strRtnVal = "Double" 
    Case dbFloat: strRtnVal = "Float" 
    Case dbGUID: strRtnVal = "GUID" 
    Case dbInteger: strRtnVal = "Integer" 
    Case dbLong: strRtnVal = "Long" 
    Case dbLongBinary: strRtnVal = "Long Binary (OLE Object)" 
    Case dbMemo: strRtnVal = "Memo" 
    Case dbNumeric: strRtnVal = "Numeric" 
    Case dbSingle: strRtnVal = "Single" 
    Case dbText: strRtnVal = "Text" 
    Case dbTime: strRtnVal = "Time" 
    Case dbTimeStamp: strRtnVal = "Time Stamp" 
    Case dbVarBinary: strRtnVal = "VarBinary" 
    Case Else: strRtnVal = "Unknown" 
    End Select 
    TypeToString = strRtnVal 
End Function 

Private Function TableExists(ByVal tableName As String) As Boolean 
    On Error Resume Next 
    TableExists = LenB(Access.CurrentDb.TableDefs(tableName).name) 
End Function