Question

我正在尝试编写一个代码，用于将表中的所有名称及其列从数据库导出到一个Excel工作表中。

到目前为止所做的代码是将所有表格及其完整信息导出到excel表格中（每个表格生成一张excel表格，但我不想这样）。以下是代码：

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

任何人都可以帮我解决这个问题。

Answer 1

这应该让你入门

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

这要求您在access vba编辑器中设置对excel的引用（使用工具，引用...）

使用vba访问在一个Excel工作表中导出每个表的表名和列名

1 个答案: