Solved

VB & Ms Access

Posted on 2004-10-18
11
368 Views
Last Modified: 2008-02-01
Could some please tell me how to get the list of the MS ACcess Table, Fields name,Field data type using VB6.
0
Comment
Question by:deepu712
[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
  • 5
  • 2
  • 2
  • +1
11 Comments
 
LVL 52

Expert Comment

by:Ryan Chong
ID: 12343567
try use ADOX or DAO object library..
0
 
LVL 52

Expert Comment

by:Ryan Chong
ID: 12343619
0
 
LVL 52

Expert Comment

by:Ryan Chong
ID: 12343659
Example using DAO:
http:Q_10082646.html

Example using ADOX, you need to add M$ ADO Ext. xx for DDL and Security Library from References:

Private Sub loadTabletoComboADO(ByVal DBFullPath As String, ByRef lst As ListBox)
    'On Error GoTo errorhandler
    On Error Resume Next
   
    Dim oCat As ADOX.Catalog
    Dim oTable As ADOX.Table
    Dim sTable As String
    Dim bFoundTable As Boolean
   
    lst.Clear
   
    Set oCat = New ADOX.Catalog
    oCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & DBFullPath & ";"
   
    For Each oTable In oCat.Tables
       
        'If oTable.Type = "TABLE" Or oTable.Type = "VIEW" Then lst.AddItem oTable.Name
        lst.AddItem oTable.Name
       
    Next
   
    Set oTable = Nothing
    Set oCat = Nothing
   
    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
    Dim oKey As ADOX.Key
   
    ListView1.ListItems.Clear
   
    Set oCat = New ADOX.Catalog
    oCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & DBFullPath & ";"
   
    Set oTable = oCat.Tables(sTable)
    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.Keys(i).Type
        ListView1.ListItems(i + 1).SubItems(4) = oTable.Columns(i).Properties("Description").Value '2
    Next i
   
       
    Set oTable = Nothing
    Set oCat = Nothing
   
    Exit Sub
errorhandler:
    MsgBox Err.Number & ": " & Err.Description
End Sub

Private Function GetDataTypeString(ByVal DataTypeNumber As ADODB.DataTypeEnum) As String
    'Dim DTNumber As ADODB.DataTypeEnum
    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 = 5s
    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
0
Technology Partners: 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 8

Expert Comment

by:ampapa
ID: 12343678
Give this a try (from an earlier post), you'll need a reference to ADO.

Type 7 = number
Type 10 = text

Public Sub findNames()


Dim DB As Database
Dim tmpTableDef As TableDef
Dim tmpField As Field

Set DB = OpenDatabase("d:\temp\my.mdb")

For Each tmpTableDef In DB.TableDefs            'loop through all tables in db
    If tmpTableDef.Attributes <> 2 Then         'filters out system tables
        For Each tmpField In tmpTableDef.Fields 'loops through all fields in table
            Debug.Print tmpTableDef.Name
            Debug.Print tmpField.Name
            Debug.Print tmpField.Type
        Next tmpField
    End If
Next tmpTableDef

End Sub
0
 
LVL 52

Expert Comment

by:Ryan Chong
ID: 12343701
ampapa, i thought what you posting is DAO, not ADO ?
0
 
LVL 8

Expert Comment

by:ampapa
ID: 12343828
Sorry, typo you're correct it is DAO.

I'm not sure you can get what your looking for this way but there is also a size property.

Public Sub findNames()


Dim DB As Database
Dim tmpTableDef As TableDef
Dim tmpField As Field

Set DB = OpenDatabase("d:\temp\my.mdb")

For Each tmpTableDef In DB.TableDefs            'loop through all tables in db
    If tmpTableDef.Attributes <> 2 Then         'filters out system tables
        For Each tmpField In tmpTableDef.Fields 'loops through all fields in table
            Debug.Print tmpTableDef.Name
            Debug.Print tmpField.Name
            Debug.Print tmpField.Type
            Debug.Print tmpField.Size
        Next tmpField
    End If
Next tmpTableDef

End Sub
0
 
LVL 10

Expert Comment

by:anv
ID: 12344620
Of Course u need to add Refernce to ADOX & DDL Library
Public Function TableNames(ConnectionString As String) _
  As Collection

On Error GoTo errHandler
Dim oCatalog As New ADOX.Catalog
Dim oTableNames As New Collection
Dim oTables As ADOX.Tables
Dim oTable As ADOX.Table
Dim oConnection As New ADODB.Connection

oConnection.ConnectionString = ConnectionString
oConnection.Open ConnectionString
Set oCatalog.ActiveConnection = oConnection
Set oTables = oCatalog.Tables

For Each oTable In oTables
    For i = 0 To oTable.Columns.Count - 1
        Debug.Print oTable.Columns(i).Name & " " & oTable.Columns(i).Type
    Next
    oTableNames.Add oTable.Name
   
Next
Set TableNames = oTableNames

errHandler:

On Error Resume Next
If oConnection.State <> 0 Then oConnection.Close
Set oConnection = Nothing
Set oCatalog = Nothing
Set oTable = Nothing
Set oTables = Nothing

End Function
0
 

Expert Comment

by:Mikkil
ID: 12347691
Deepu,

There is also the Openschema method.

example code :

Set rstest = New ADODB.Recordset
Set rstest = cn(1).OpenSchema(adSchemaViews)
rstest.MoveFirst
While Not rstest.EOF
        'MsgBox rstest!table_name
        List(listsub).AddItem List(listsub).ListCount & rstest.Fields(2).Value & vbTab & rstest.Fields(3).Value & vbTab & rstest.Fields(7).Value & vbTab & rstest.Fields(8).Value
        'MsgBox rstest!Type_name
        'MsgBox rstest!Column_name
        rstest.MoveNext
Wend
Set rstest = cn(1).OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "table"))
rstest.MoveFirst
While Not rstest.EOF
        'MsgBox rstest!table_name
        List(listsub + 1).AddItem List(listsub + 1).ListCount & rstest.Fields(2).Value & vbTab & rstest.Fields(3).Value & vbTab & rstest.Fields(7).Value & vbTab & rstest.Fields(8).Value
        'MsgBox rstest!Type_name
        'MsgBox rstest!Column_name
        rstest.MoveNext
    Wend

The other comments above are much better / instructive, but I liked Openschema. It gives the option of operating at different levels.

further example :
Dim testdb As ADODB.Connection
    Set testdb = New ADODB.Connection
    Dim sch As ADODB.Recordset
    Dim flds As ADODB.Recordset
    Dim keys As ADODB.Recordset
    With testdb
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = db
        .CursorLocation = adUseClient
        .Open
    End With
    Set sch = testdb.OpenSchema(adSchemaTables)
    'MsgBox "Tables" & sch.RecordCount & "items " & db
    sch.MoveFirst
    str = ""
    For x = 0 To sch.Fields.count - 1
        str = str & sch.Fields(x).name & vbTab & sch.Fields(x).Value & vbCrLf
    Next x
    'MsgBox str
    While Not sch.EOF
        str = ""
        'MsgBox sch.Fields.count
        'msgbox sch.
        For x = 0 To sch.Fields.count - 1
            str = str & sch.Fields(x).name & vbTab & sch.Fields(x).Value & vbCrLf
        Next x
        'MsgBox str
        'str = str & sch.Fields(x).Name & vbTab & sch.Fields(x).Value & vbCrLf
        Const tabname = 2
        Const tabtype = 3
        Const tabcrea = 7
        Const tabmod = 8
        If sch.Fields(3).Value = "TABLE" Then
            tablecnt = tablecnt + 1
            coll.Add db & "," & sch.Fields(tabtype).Value & "," & sch.Fields(tabname).Value & "," & sch.Fields(tabcrea).Value & "," & sch.Fields(tabmod).Value
            Set flds = testdb.OpenSchema(adSchemaColumns, Array(Empty, Empty, sch.Fields(2).Value))
            flds.MoveFirst
            Dim listb As ListBox
            str = ""
            'listb.Clear
            'listb.Sorted = True
            While Not flds.EOF
                'MsgBox flds.Fields.count
                'str = ""
                'For x = 0 To flds.Fields.count - 1
                    'str = str & flds.Fields(x).Name & vbTab & flds.Fields(x).Value & vbCrLf
                'Next x
                'MsgBox str
                'MsgBox flds.Fields(3).Value & vbTab & flds.Fields(6).Value & vbTab & flds.Fields(13).Value
                'While Not flds.EOF
                    'MsgBox db & vbTab & sch.Fields(3).Value & vbTab & _
                        "Fields" & vbTab '& flds.Value
                'Wend
                'MsgBox db & vbTab & sch.Fields(3).Value & vbTab & sch.Fields(2).Value & vbTab & flds.Fields(3).Value & vbTab & flds.Fields(13).Value & vbTab & flds.Fields(6).Value
                str = str & Chr(124) & flds.Fields(3).Value & "," & flds.Fields(13).Value & "," & flds.Fields(6).Value
               
                flds.MoveNext
            Wend
            'MsgBox str
            coll.Add db & "," & sch.Fields(3).Value & "," & sch.Fields(2).Value & str '& "," & flds.Fields(3).Value '& "," & flds.Fields(13).Value & "," & flds.Fields(6).Value
            'MsgBox listb.ListCount
        End If
        'MsgBox str
        sch.MoveNext
    Wend

Not beautiful code, but it works.

The reason for doing it was to identify tables / queries on multiple database with a view to aggregating on one database (based on date modified etc.)

Mikkil
0
 
LVL 10

Expert Comment

by:anv
ID: 12572447
i believe the answer i gave is the solution to the given problem...

0
 
LVL 52

Accepted Solution

by:
Ryan Chong earned 125 total points
ID: 12572503
I prefer a split among ryancys, ampapa, Mikkil and anv, since deepu712 didn't provide us a clear explaination on how he/she gonna to get the list of the MS ACcess Table, Fields name,Field data type using VB6.

cheers 8-)
0

Featured Post

Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

Question has a verified solution.

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

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…
Suggested Courses
Course of the Month11 days, 10 hours left to enroll

623 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