Solved

list tablename and fieldname using sql

Posted on 2002-04-08
6
542 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
6 Comments
 
LVL 6

Expert Comment

by:Mach1pro
ID: 6927205
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 52

Expert Comment

by:Ryan Chong
ID: 6927232
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
ID: 6927326
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 6

Expert Comment

by:Mach1pro
ID: 6927905
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
ID: 7102440
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
ID: 7120118
Per recommendation, force-accepted.

Netminder
CS Moderator
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
Familiarize people with the process of utilizing SQL Server functions 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 Ac…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

739 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