MS Excel VBA - Import an access (MDB) tables structure

Question

I have this snippet that will import an access table into excel. the MDB path is in range C2 and the table name is is C4

Is there a way I can import the table's properties/design and write it into a new place using excel vba? This will be used for many people of varying skill levels with varying table structures to import. The data will eventually have to go back into access but I am getting tripped up on how to make sure the field properties are correct within access.

Sub GetData()

DeleteConnections 'remove existing connections in case they persist
Sheet4.Cells.Clear 'clear the old table

Sheets("Import").Activate

DatabaseName = Sheets("Setup").Range("C2").Value
TableName = Sheets("Setup").Range("C4").Value

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & DatabaseName & "" _
        , _
        ";Mode=Share" _
        , _
        " Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OL" _
        , _
        "EDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet" _
        , _
        " OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Loc" _
        , _
        "ale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet" _
        , " OLEDB:Bypass UserInfo Validation=False"), Destination:=Range("$A$1")). _
        QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("" & TableName & "")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "" & DatabaseName & ""
        .ListObject.DisplayName = "" & TableName & ""
        .Refresh BackgroundQuery:=False
    End With

DeleteConnections 'remove the new connection

End Sub

Answer 1

If all you want is the structure of the table, you can hijack the ADODB.RecordSet class to expose the field names, data types and lengths. Something like this should work. In this example they will just list them down in columns A, B and C of the active spreadsheet:

Sub GetDataFieldInfo()

  Dim conn As ADODB.Connection
  Dim rs As ADODB.Recordset

  Set conn = New ADODB.Connection
  conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0" & _
      ";Data Source=" & DatabaseName & _
      ";Persist Security Info=False;"
  conn.Open

  Set rs = conn.Execute("select * from " & TableName)
  For i = 0 To rs.Fields.Count - 1
    Cells(i + 1, 1).Value2 = rs(i).Name
    Cells(i + 1, 2).Value2 = TypeName(rs.Fields(i).Value)
    Cells(i + 1, 3).Value2 = rs.Fields(i).DefinedSize
  Next
  rs.Close

End Sub

I ran this on a sample table, and the results look like this:

ID              Long             4
Date Entered    Date             8
Business Unit   String         255
Type Code       String         255

You may want to see how this handles null data.

Answer 2

Here is a snippet that will iterate through the column names of a QueryTable's source table:

Dim qt As QueryTable
Dim lo As ListObject
Dim lc As ListColumn

Set qt = ActiveSheet.ListObjects(1).QueryTable

Set lo = qt.ListObject

For Each lc In lo.ListColumns
    Debug.Print lc.Name
Next

Set lc = Nothing
Set lo = Nothing
Set qt = Nothing

This is verbose for demonstrative purposes, and can obviously be refactored.