MS Access Tabellenstrukturen exportieren
Ich muss mich gelegentlich mit MS Access beschäftigen und habe eine Möglichkeit gesucht, Tabellenstrukturen zu exportieren. Basierend auf Code von Allen Browne (http://allenbrowne.com/func-06.html) habe ich um seine TableInfo()
Funktion eine Exportfunktion geschrieben.
Option Compare Database ' based on http://allenbrowne.com/func-06.html ' modified for the export of the information by Uwe Ziegenhagen Sub exportTableInformation() On Error GoTo TableInfoErr ' Purpose: Display the field names, types, sizes and descriptions for a table. ' Argument: Name of a table in the current database. Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Set db = CurrentDb() ' ask user for path of the output file ' https://support.office.com/de-de/article/InputBox-Funktion-Eingabefeld-17821927-28b7-4350-b7f1-4786575314d9 Dim Message, Title, Default, MyValue Message = "File will be overwritten..." ' Set prompt. Title = "Enter file of output file" ' Set title. Default = "c:\somefile.csv" ' Set default. ' Display message, title, and default value. outputfilePath = InputBox(Message, Title, Default) n = FreeFile() Open outputfilePath For Output As #n Print #n, "SOURCE;TABLE;FIELDNAME;FIELDTYPE;SIZE;DESCRIPTION" Set db = CurrentDb() Debug.Print For Each tdf In db.TableDefs ' ignore system and temporary tables If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then For Each fld In tdf.Fields Debug.Print db.Name & ";" & tdf.Name & ";" & fld.Name & ";" & FieldTypeName(fld) & ";" & fld.Size & ";" & GetDescrip(fld) Print #n, db.Name & ";" & tdf.Name & ";" & fld.Name & ";" & FieldTypeName(fld) & ";" & fld.Size & ";" & GetDescrip(fld) Next End If Next Set tdf = Nothing Set db = Nothing Close #n TableInfoExit: Set db = Nothing Exit Sub TableInfoErr: Select Case Err Case 3265& 'Table name invalid MsgBox strTableName & " table doesn't exist" Case Else Debug.Print "TableInfo() Error " & Err & ": " & Error End Select Resume TableInfoExit End Sub Function GetDescrip(obj As Object) As String ' http://allenbrowne.com/func-06.html On Error Resume Next GetDescrip = obj.Properties("Description") End Function Function FieldTypeName(fld As DAO.Field) As String 'http://allenbrowne.com/func-06.html 'Purpose: Converts the numeric results of DAO Field.Type to text. Dim strReturn As String 'Name to return Select Case CLng(fld.Type) 'fld.Type is Integer, but constants are Long. Case dbBoolean: strReturn = "Yes/No" ' 1 Case dbByte: strReturn = "Byte" ' 2 Case dbInteger: strReturn = "Integer" ' 3 Case dbLong ' 4 If (fld.Attributes And dbAutoIncrField) = 0& Then strReturn = "Long Integer" Else strReturn = "AutoNumber" End If Case dbCurrency: strReturn = "Currency" ' 5 Case dbSingle: strReturn = "Single" ' 6 Case dbDouble: strReturn = "Double" ' 7 Case dbDate: strReturn = "Date/Time" ' 8 Case dbBinary: strReturn = "Binary" ' 9 (no interface) Case dbText '10 If (fld.Attributes And dbFixedField) = 0& Then strReturn = "Text" Else strReturn = "Text (fixed width)" '(no interface) End If Case dbLongBinary: strReturn = "OLE Object" '11 Case dbMemo '12 If (fld.Attributes And dbHyperlinkField) = 0& Then strReturn = "Memo" Else strReturn = "Hyperlink" End If Case dbGUID: strReturn = "GUID" '15 'Attached tables only: cannot create these in JET. Case dbBigInt: strReturn = "Big Integer" '16 Case dbVarBinary: strReturn = "VarBinary" '17 Case dbChar: strReturn = "Char" '18 Case dbNumeric: strReturn = "Numeric" '19 Case dbDecimal: strReturn = "Decimal" '20 Case dbFloat: strReturn = "Float" '21 Case dbTime: strReturn = "Time" '22 Case dbTimeStamp: strReturn = "Time Stamp" '23 'Constants for complex types don't work prior to Access 2007 and later. Case 101&: strReturn = "Attachment" 'dbAttachment Case 102&: strReturn = "Complex Byte" 'dbComplexByte Case 103&: strReturn = "Complex Integer" 'dbComplexInteger Case 104&: strReturn = "Complex Long" 'dbComplexLong Case 105&: strReturn = "Complex Single" 'dbComplexSingle Case 106&: strReturn = "Complex Double" 'dbComplexDouble Case 107&: strReturn = "Complex GUID" 'dbComplexGUID Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal Case 109&: strReturn = "Complex Text" 'dbComplexText Case Else: strReturn = "Field type " & fld.Type & " unknown" End Select FieldTypeName = strReturn End Function |