Как извлечь таблицу дизайна на листы Excel?

Question

Мне нужен столбец и тип данных таблицы в форме доступа VBA ms

как это сделать легко?

Answer 1

Дайте этому попытку:

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