Как извлечь дизайн таблицы в лист Excel? - PullRequest
0 голосов
/ 14 сентября 2009

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

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

1 Ответ

0 голосов
/ 15 сентября 2009

Попробуйте:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...