Export table names and column names of each table in one excel sheet using vba access

Question

I am trying to write a code for exporting all the name of the tables and their columns from database into one excel sheet.

The code done till now is exporting all the tables with their complete information into excel sheets (each table generates one excel sheet but i don'want like this). Below is the code :

Private Sub Commande49_Click()
On Error GoTo Err_Commande49_Click
 Dim strOut As String
  Dim tbl As AccessObject
  Dim f As Boolean
  With Application.FileDialog(4) ' msoFileDialogFolderPicker
    .Title = "Please select the target folder"
    If .Show Then
      strOut = .SelectedItems(1)
      If Not Right(strOut, 1) = "\" Then
        strOut = strOut & "\"
      End If
    Else
      MsgBox "You didn't select a target folder.", vbExclamation
      Exit Sub
    End If
  End With
  f = (MsgBox("Do you want to export all tables to Excel (No = CSV)?", _
    vbQuestion + vbYesNo) = vbYes)
  For Each tbl In CurrentData.AllTables
    If Not tbl.Name Like "MSys*" And Not tbl.Name Like "~" Then
      If f Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
          tbl.Name, strOut & tbl.Name & ".xlsx", True
      Else
        DoCmd.TransferText acExportDelim, , _
          tbl.Name, strOut & tbl.Name & ".csv", True
      End If
    End If
  Next tbl
Exit_Commande49_Click:
    Exit Sub

Can anyone please help me with this issue.

Andy Brazil Andy Brazil · Accepted Answer · 2015-12-29T16:23:12

This should get you started

Sub AllTables()
Dim xl As New excel.Application
Dim wb As excel.workbook
Dim ws As excel.worksheet
Set wb = xl.workbooks.Add
Set ws = wb.worksheets.Add
Dim r As range
Dim x As Integer
Set r = ws.range("a1")
Dim dbs As Database
Set dbs = Application.CurrentDb
Dim td As TableDef
Dim f As Field
For Each td In dbs.TableDefs
    If Left(td.Name, 4) <> "MSys" Then
         r = td.Name
         x = 2
         For Each f In td.Fields
             r.offset(0, x) = f.Name
             x = x + 1
         Next f
         Set r = r.offset(1, 0)
   End If
Next td

End Sub

This requires you to set a reference to excel in the access vba editor (using Tools,References...)

Export table names and column names of each table in one excel sheet using vba access

1 Answers