Solved

list tablename and fieldname using sql

Posted on 2002-04-08
6
492 Views
Last Modified: 2012-08-13
How do u list the tablename and fieldname in a db using sql statement?
0
Comment
Question by:ghgan
6 Comments
 
LVL 6

Expert Comment

by:Mach1pro
Comment Utility
Dim db as Dao.Database
Dim td as Dao.TableDef
Dim fld as Field

Set db = CurrentDb
For Each td In db.Tabledefs
     Debug.Print td.Name
     For Each fld In td.Fields
        Debug.Print fld.Name
     Next fld
Next td
Set db = Nothing
0
 
LVL 49

Expert Comment

by:Ryan Chong
Comment Utility
Hi ghgan,

This Form contain some useful + extra codes:

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmOpenDatabaseDAO
   Caption         =   "frmCreateDatabase"
   ClientHeight    =   7875
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11055
   LinkTopic       =   "Form1"
   ScaleHeight     =   7875
   ScaleWidth      =   11055
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Command5
      Caption         =   "Command5"
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   7440
      Width           =   2535
   End
   Begin VB.CheckBox Check1
      Caption         =   "Check1"
      Height          =   375
      Left            =   7800
      TabIndex        =   8
      Top             =   6960
      Width           =   975
   End
   Begin VB.CommandButton Command4
      Caption         =   "Command2"
      Height          =   375
      Left            =   8880
      TabIndex        =   7
      Top             =   6960
      Width           =   255
   End
   Begin VB.TextBox Text2
      Height          =   405
      Left            =   120
      TabIndex        =   6
      Text            =   "Text2"
      Top             =   6960
      Width           =   7575
   End
   Begin VB.CommandButton Command3
      Caption         =   "Command3"
      Height          =   375
      Left            =   9240
      TabIndex        =   5
      Top             =   6960
      Width           =   1695
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   4200
      Top             =   1320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command2
      Caption         =   "Command2"
      Height          =   375
      Left            =   9240
      TabIndex        =   4
      Top             =   120
      Width           =   255
   End
   Begin MSComctlLib.ListView ListView1
      Height          =   6255
      Left            =   3120
      TabIndex        =   3
      Top             =   600
      Width           =   7815
      _ExtentX        =   13785
      _ExtentY        =   11033
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.ListBox List1
      Height          =   6300
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   2895
   End
   Begin VB.TextBox Text1
      Height          =   405
      Left            =   120
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   120
      Width           =   9015
   End
   Begin VB.CommandButton Command1
      Caption         =   "Command1"
      Height          =   375
      Left            =   9600
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
End
Attribute VB_Name = "frmOpenDatabaseDAO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Function GetDataTypeString(ByVal DataTypeNumber As Long) As String
    Select Case DataTypeNumber
    Case 0: GetDataTypeString = "Empty" 'adEmpty = 0
    Case 16: GetDataTypeString = "Tiny Int" 'adTinyInt = 16
    Case 2: GetDataTypeString = "Small Int" 'adSmallInt = 2
    Case 3: GetDataTypeString = "Integer" 'adInteger = 3
    Case 20: GetDataTypeString = "Big Int" 'adBigInt = 20
    Case 17: GetDataTypeString = "Unsigned Tiny Int" 'adUnsignedTinyInt = 17
    Case 18: GetDataTypeString = "Unsigned Small Int" 'adUnsignedSmallInt = 18
    Case 19: GetDataTypeString = "Unsigned Int" 'adUnsignedInt = 19
    Case 21: GetDataTypeString = "Unsigned Big Int" 'adUnsignedBigInt = 21
    Case 4: GetDataTypeString = "Single" 'adSingle = 4
    Case 5: GetDataTypeString = "Double" 'adDouble = 5
    Case 6: GetDataTypeString = "Currency" 'adCurrency = 6
    Case 14: GetDataTypeString = "Decimal" 'adDecimal = 14
    Case 131: GetDataTypeString = "Numeric" 'adNumeric = 131
    Case 11: GetDataTypeString = "Boolean" 'adBoolean = 11
    Case 10: GetDataTypeString = "Error" 'adError = 10
    Case 132: GetDataTypeString = "User Defined" 'adUserDefined = 132
    Case 12: GetDataTypeString = "Variant" 'adVariant = 12
    Case 9: GetDataTypeString = "IDispatch" 'adIDispatch = 9
    Case 13: GetDataTypeString = "IUnknown" 'adIUnknown = 13
    Case 72: GetDataTypeString = "GUID" 'adGUID = 72
    Case 7: GetDataTypeString = "Date" 'adDate = 7
    Case 133: GetDataTypeString = "DBDate" 'adDBDate = 133
    Case 134: GetDataTypeString = "DBTime" 'adDBTime = 134
    Case 135: GetDataTypeString = "DBTimeStamp" 'adDBTimeStamp = 135
    Case 8: GetDataTypeString = "BSTR" 'adBSTR = 8
    Case 129: GetDataTypeString = "Char" 'adChar = 129
    Case 200: GetDataTypeString = "VarChar" 'adVarChar = 200
    Case 201: GetDataTypeString = "Long VarChar" 'adLongVarChar = 201
    Case 130: GetDataTypeString = "WChar" 'adWChar = 130
    Case 202: GetDataTypeString = "VarWChar" 'adVarWChar = 202
    Case 203: GetDataTypeString = "Long VarWChar" 'adLongVarWChar = 203
    Case 128: GetDataTypeString = "Binary" 'adBinary = 128
    Case 204: GetDataTypeString = "VarBinary" 'adVarBinary = 204
    Case 205: GetDataTypeString = "Long VarBinary" 'adLongVarBinary = 205
    Case 136: GetDataTypeString = "Chapter" 'adChapter = 136
    Case 64: GetDataTypeString = "FileTime" 'adFileTime = 64
    Case 137: GetDataTypeString = "DB FileName" 'adDBFileTime = 137
    Case 138: GetDataTypeString = "Prop Variant" 'adPropVariant = 138
    Case 139: GetDataTypeString = "VarNumeric" 'adVarNumeric = 139
    Case Else: GetDataTypeString = "None"
    End Select
End Function

Private Function OpenDatabase(ByVal DBFullPath As String, ByVal InitialTable As String) As Boolean

    Dim db As DAO.Database
    Dim td As DAO.TableDef
    Dim f As DAO.Field
   
    On Error GoTo ErrorHandler
    Set db = DBEngine.OpenDatabase(DBFullPath)
    Set td = db.CreateTableDef(InitialTable)
   
    Set f = td.CreateField("ID", dbLong)
    f.Required = True
    td.Fields.Append f
    Set f = td.CreateField("myDate", dbDate)
    td.Fields.Append f
    Set f = td.CreateField("myText", dbText)
    f.AllowZeroLength = True
    f.SIZE = 50
    td.Fields.Append f
    Set f = td.CreateField("myMemo", dbMemo)
    td.Fields.Append f
    Set f = td.CreateField("myBol", dbBoolean)
    td.Fields.Append f
    Set f = td.CreateField("myNum", dbInteger)
    td.Fields.Append f
   
    db.TableDefs.Append td
   
    OpenDatabase = True
    Exit Function
ErrorHandler:
    If Not db Is Nothing Then db.Close
    OpenDatabase = False
End Function

Private Sub Command1_Click()
    If OpenDatabase(Text1.Text, "myTable1") Then
        MsgBox "Table Created"
    Else
        MsgBox "Table Not Created"
    End If
End Sub

Private Sub Command2_Click()
    CommonDialog1.FileName = ""
    CommonDialog1.Filter = "Access (*.mdb)|*.mdb|All Files (*.*)|*.*"
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName <> "" Then Text1.Text = CommonDialog1.FileName: loadTabletoComboADO Text1.Text
End Sub

Private Sub Command3_Click()
    If ListView1.ListItems.Count > 0 And Text2.Text <> "" Then ExportFromListViewToExcel Text2.Text, List1.Text, ListView1
End Sub

Private Sub Command4_Click()
    'CommonDialog1.FileName = List1.Text
    CommonDialog1.FileName = ""
    CommonDialog1.Filter = "Excel (*.xls)|*.xls|All Files (*.*)|*.*"
    CommonDialog1.ShowSave
    If CommonDialog1.FileName <> "" Then Text2.Text = CommonDialog1.FileName
End Sub

Private Sub Command5_Click()
    Dim oCat As ADOX.Catalog
    Dim oTable As ADOX.Table
    Dim sTable As String
   
    Set oCat = New ADOX.Catalog
    Text1.Text = "D:\Project\Icon\Database\database.mdb"
    oCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & Text1.Text & ";"
       
       
    For Each oTable In oCat.Tables
        If oTable.Name = "POrder" Then
            oTable.Columns.Append "MyNewTextField", adVarWChar, 200
            oTable.Columns.Append "MyNewCurField", adCurrency
            oTable.Columns.Append "MyNewDateField", adDate
            oTable.Columns.Append "MyNewBolField", adBoolean
            oTable.Columns.Append "MyNewSmallIntField", adSmallInt
            Exit For
        End If
    Next
   
    Set oTable = Nothing
    Set oCat = Nothing
End Sub

Private Sub Form_Load()
    Text1.Text = "D:\Project\Icon\Database\database.mdb"
    Text2.Text = ""
    Check1.Caption = "Quit after Export"
    loadTabletoComboADO Text1.Text
   
    CommonDialog1.flags = 6
   
    Command1.Caption = "Create Table"
    Command2.Caption = ".."
    Command3.Caption = "Export to Excel"
    Command4.Caption = ".."
    Command5.Caption = "Add Fields in table"
    ListView1.ListItems.Clear
    ListView1.View = lvwReport
    ListView1.LabelEdit = lvwManual
    ListView1.FullRowSelect = True
    ListView1.ColumnHeaders.Add 1, , "Field Name"
    ListView1.ColumnHeaders.Add 2, , "Data Type"
    ListView1.ColumnHeaders.Add 3, , "Length"
    ListView1.ColumnHeaders.Add 4, , "Remarks"
    ListView1.ColumnHeaders(4).Width = ListView1.Width - ListView1.ColumnHeaders(1).Width - ListView1.ColumnHeaders(2).Width - ListView1.ColumnHeaders(3).Width - 350
End Sub

Private Sub loadTabletoCombo(ByVal DBFullPath As String)
    Dim db As DAO.Database
    Dim td As DAO.TableDef
    Dim f As DAO.Field

    On Error GoTo ErrorHandler
    Set db = DBEngine.OpenDatabase(DBFullPath)
   
    List1.Clear
    For i = 0 To db.TableDefs.Count - 1
        If Left(db.TableDefs(i).Name, 4) <> "MSys" Then 'Remove the System Tables
            List1.AddItem db.TableDefs(i).Name
        End If
    Next i
   
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
   
End Sub

Private Sub loadTabletoComboADO(ByVal DBFullPath As String)
    On Error GoTo ErrorHandler
   
    Dim oCat As ADOX.Catalog
    Dim oTable As ADOX.Table
    Dim sTable As String
    Dim bFoundTable As Boolean
   
    List1.Clear
   
    Set oCat = New ADOX.Catalog
    oCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & DBFullPath & ";"
   
    For Each oTable In oCat.Tables
        List1.AddItem oTable.Name
    Next
   
    Set oTable = Nothing
    Set oCat = Nothing
   
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
   
End Sub

Private Sub List1_Click()
    showFieldNameADO Text1.Text, List1.Text
    'GetQueryInfo "C:\db1.mdb"
End Sub

Private Sub GetQueryInfo(ByVal DBFullPath As String) 'Use 97 mdb
    Dim db As DAO.Database
    Dim td As DAO.TableDef
    Dim f As DAO.Field

    On Error GoTo ErrorHandler
    Set db = DBEngine.OpenDatabase(DBFullPath)
   
    For i = 0 To db.QueryDefs.Count - 1
        Debug.Print db.QueryDefs(i).Sql
    Next i
   
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Private Sub showFieldName()
    Dim db As DAO.Database
    Dim td As DAO.TableDef
    Dim f As DAO.Field

    On Error GoTo ErrorHandler
    Set db = DBEngine.OpenDatabase(DBFullPath)
   
    For i = 0 To db.TableDefs(List1.Text).Fields.Count - 1
        db.QueryDefs(i).Sql
        ListView1.ListItems.Add i + 1, , db.TableDefs(List1.Text).Fields(i).Name
        ListView1.ListItems(i + 1).SubItems(1) = db.TableDefs(List1.Text).Fields(i).Type
        ListView1.ListItems(i + 1).SubItems(2) = db.TableDefs(List1.Text).Fields(i).SIZE
        ListView1.ListItems(i + 1).SubItems(3) = db.TableDefs(List1.Text).Fields(i).VisibleValue
    Next i
   
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Private Sub showFieldNameADO(ByVal DBFullPath As String, ByVal sTable As String)
    'On Error GoTo ErrorHandler
   
    Dim oCat As ADOX.Catalog
    Dim oTable As ADOX.Table
   
    ListView1.ListItems.Clear
   
    Set oCat = New ADOX.Catalog
    oCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & DBFullPath & ";"
   
    For Each oTable In oCat.Tables
        If UCase(oTable.Name) = UCase(sTable) Then
            For i = 0 To oTable.Columns.Count - 1
                ListView1.ListItems.Add i + 1, , oTable.Columns(i).Name
                ListView1.ListItems(i + 1).SubItems(1) = GetDataTypeString(oTable.Columns(i).Type)
                ListView1.ListItems(i + 1).SubItems(2) = oTable.Columns(i).DefinedSize
                ListView1.ListItems(i + 1).SubItems(3) = oTable.Columns(i).Properties(2).Value
            Next i
        End If
    Next
   
    Set oTable = Nothing
    Set oCat = Nothing
   
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Private Sub ExportFromListViewToExcel(ByVal TargetFile As String, ByVal SheetName As String, ByVal myListView As MSComctlLib.ListView)
    Dim iExcel As New Excel.Application
    Dim iExcelWB As Excel.Workbook
    Dim iExcelWS As Excel.Worksheet
   
    iExcel.Visible = True
   
    If Dir$(TargetFile) <> "" Then
        iExcel.Workbooks.Open TargetFile
    Else
        iExcel.Workbooks.Add
    End If
    i = iExcel.Workbooks.Count
    Set iExcelWB = iExcel.Workbooks(i)
   
    iExcelWB.Worksheets.Add
    j = iExcel.Workbooks(i).Worksheets.Count
   
    'Set iExcelWS = iExcelWB.Worksheets(j)
    Set iExcelWS = iExcelWB.ActiveSheet
    iExcelWS.Name = SheetName
    DoEvents
   
    iExcelWS.Columns(1).ColumnWidth = 20
    iExcelWS.Columns(2).ColumnWidth = 10
    iExcelWS.Columns(3).ColumnWidth = 10
    iExcelWS.Columns(4).ColumnWidth = 50
    'iExcelWS.Range("A1", "G100").EntireColumn.AutoFit
    iExcelWS.Range("A1", "D1").Font.Bold = True
    iExcelWS.Range("A1", "G100").EntireColumn.WrapText = True
   
    For j = 1 To myListView.ColumnHeaders.Count
        iExcelWS.Cells(1, j).Value = myListView.ColumnHeaders(j).Text
    Next j
   
    For j = 1 To myListView.ListItems.Count
        iExcelWS.Cells(j + 1, 1).Value = myListView.ListItems(j).Text
        For h = 1 To myListView.ColumnHeaders.Count - 1
            iExcelWS.Cells(j + 1, h + 1).Value = myListView.ListItems(j).SubItems(h)
        Next h
    Next j
   
    iExcel.Workbooks(i).Save
   
    If Check1.Value = 1 Then
        iExcelWB.Save
        iExcelWB.Close
        iExcel.Quit
        Set iExcelWS = Nothing
        Set iExcelWB = Nothing
        Set iExcel = Nothing
    End If
End Sub

Cheers
0
 
LVL 12

Accepted Solution

by:
Paurths earned 20 total points
Comment Utility
surely u dont want the system-tables in your listbox...

Dim db as Database
Dim td as TableDef
Dim fld as Field

Set db = CurrentDb
For Each td In db.Tabledefs
    If UCase(Left(tdf.Name, 4)) <> "MSYS" Then
       Debug.Print td.Name
       For Each fld In td.Fields
          Debug.Print fld.Name
       Next fld
    End If
Next td
Set db = Nothing
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 6

Expert Comment

by:Mach1pro
Comment Utility
OOPS!  
Forgot about the system tables. I was just typing that code off the top of my head.
Looks like Paurths has got it.
0
 
LVL 54

Expert Comment

by:nico5038
Comment Utility
for ghgan

No comment has been added for the last two months.
So it's time to clean up this TA.
I will leave a recommendation in Community Support that this question is:
 - Answered by: Paurths  
Please leave any comments here within the
next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER !

Nic;o)
0
 
LVL 5

Expert Comment

by:Netminder
Comment Utility
Per recommendation, force-accepted.

Netminder
CS Moderator
0

Featured Post

Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Join & Write a Comment

Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now