Solved

VB & Ms Access

Posted on 2004-10-18
11
362 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
  • 5
  • 2
  • 2
  • +1
11 Comments
 
LVL 49

Expert Comment

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

Expert Comment

by:Ryan Chong
ID: 12343619
0
 
LVL 49

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
 
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 49

Expert Comment

by:Ryan Chong
ID: 12343701
ampapa, i thought what you posting is DAO, not ADO ?
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 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 49

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

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
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…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

762 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