VBA（？）：将Microsoft Access数据库记录到数据集（列表/字段/带有字段的查询）

Question

寻找一种方式来获取Access数据库并导出类似内容：

| Type           |   Name       |   Field     |     Field Type      |     Example values         |  SQL                                     |
| Table          |   Table1     |   Field1    |     String          |     Field example 1/2/3    |                                          | 
| Table          |   Table1     |   Field2    |     String          |     Field example 1/2/3    |                                          |
| Table          |   Table1     |   Field3    |     String          |     Field example 1/2/3    |                                          |
| ViewOutput     | SelectedCols |   Field 1   |     ...             |     Field example 1/2/3    |                                          |
| ViewOutput     | SelectedCols |   Field 2   |     ...             |     Field example 1/2/3    |                                          |
| ViewDefinition | SelectedCols |   Field 1   |     Field Type      |                            |  SELECT [field1], [field2] from [Table1] |

换一种说法：

• 显示的电子表格/数据集
  • 所有表的名称，以及基础字段名/类型/一些示例列值（*）
  • 所有名称的视图以及定义的字段名称和示例值（*）

*理想/可选地，我得到三个以逗号分隔的示例字段值

这将是从Access迁移到更严重的数据库的一个令人惊奇的起点，对此深表感谢。

Answer 1

从我的角度来看， 这个问题确实太广泛了，没有显示出任何努力 ，但至少您可以有一个起点。 我编写了列出表和查询（不包括SYS表，但您可以根据需要进行调整）的代码。 它还列出了字段名称和类型。

关于获取示例值，为此，您需要为每个对象打开一个记录集，执行此代码非常耗时。 另外，当查询/表可能有0,1或2时，您要求1-3个值，因此每次记录计数时也必须检查等等。 所以我忽略了那部分。

但是至少代码会获得带有名称，字段和字段名称的表和查询。

BONUS：是的，它也将获得查询的SQL代码。

Private Sub SHOW_DB_INFO()

Dim db As Database
Dim tdf As TableDef
Dim x As Integer
Dim i As Double

Dim AppExcel As Object
Dim WK As Object

Set AppExcel = CreateObject("Excel.Application")
AppExcel.Visible = False
AppExcel.ScreenUpdating = False
AppExcel.Workbooks.Add

Set WK = AppExcel.ActiveWorkbook.ActiveSheet




Set db = CurrentDb


For Each tdf In db.TableDefs
   If Left(tdf.Name, 4) <> "MSys" Then ' Don't enumerate the system tables
      For x = 0 To tdf.Fields.Count - 1
        i = i + 1
        WK.Range("A" & i).Value = "Table"
        WK.Range("B" & i).Value = tdf.Name
        WK.Range("C" & i).Value = tdf.Fields(x).Name
        WK.Range("D" & i).Value = FLD_TYPENAME(tdf.Fields(x).Type) 'enumeration can be found here: https://docs.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/datatypeenum-enumeration-dao
      Next x
   End If
Next tdf

Dim qdf As QueryDef
For Each qdf In db.QueryDefs
    For x = 0 To qdf.Fields.Count - 1
        i = i + 1
        WK.Range("A" & i).Value = "Query"
        WK.Range("B" & i).Value = qdf.Name
        WK.Range("C" & i).Value = qdf.Fields(x).Name
        WK.Range("D" & i).Value = FLD_TYPENAME(qdf.Fields(x).Type)
        WK.Range("E" & i).Value = qdf.SQL
    Next x
Next qdf

AppExcel.Visible = True
AppExcel.ScreenUpdating = True

Set WK = Nothing
Set AppExcel = Nothing

End Sub

您还需要此UDF

Private Function FLD_TYPENAME(ByVal vType As Integer) As String
Select Case vType
    Case Is = 101: FLD_TYPENAME = "Attachment data"
    Case Is = 16: FLD_TYPENAME = "Big Integer data"
    Case Is = 9: FLD_TYPENAME = "Binary data"
    Case Is = 1: FLD_TYPENAME = "Boolean (True/False) data"
    Case Is = 2: FLD_TYPENAME = "Byte (8-bit) data"
    Case Is = 18: FLD_TYPENAME = "Text data (fixed width)"
    Case Is = 102: FLD_TYPENAME = "Multi-valued byte data"
    Case Is = 108: FLD_TYPENAME = "Multi-value decimal data"
    Case Is = 106: FLD_TYPENAME = "Multi-value double-precision floating-point data"
    Case Is = 107: FLD_TYPENAME = "Multi-value GUID data"
    Case Is = 103: FLD_TYPENAME = "Multi-value integer data"
    Case Is = 104: FLD_TYPENAME = "Multi-value long integer data"
    Case Is = 105: FLD_TYPENAME = "Multi-value single-precision floating-point data"
    Case Is = 109: FLD_TYPENAME = "Multi-value Text data (variable width)"
    Case Is = 5: FLD_TYPENAME = "Currency data"
    Case Is = 8: FLD_TYPENAME = "Date value data"
    Case Is = 20: FLD_TYPENAME = "Decimal data (ODBCDirect only)"
    Case Is = 7: FLD_TYPENAME = "Double-precision floating-point data"
    Case Is = 21: FLD_TYPENAME = "Floating-point data (ODBCDirect only)"
    Case Is = 15: FLD_TYPENAME = "GUID data"
    Case Is = 3: FLD_TYPENAME = "Integer data"
    Case Is = 4: FLD_TYPENAME = "Long Integer data"
    Case Is = 11: FLD_TYPENAME = "Binary data (bitmap)"
    Case Is = 12: FLD_TYPENAME = "Memo data (extended text)"
    Case Is = 19: FLD_TYPENAME = "Numeric data (ODBCDirect only)"
    Case Is = 6: FLD_TYPENAME = "Single-precision floating-point data"
    Case Is = 10: FLD_TYPENAME = "Text data (variable width)"
    Case Is = 22: FLD_TYPENAME = "Data in time format (ODBCDirect only)"
    Case Is = 23: FLD_TYPENAME = "Data in time and date format (ODBCDirect only)"
    Case Is = 17: FLD_TYPENAME = "Variable Binary data (ODBCDirect only)"
    Case Else: FLD_TYPENAME = "Not found/Unknown"
End Select

End Function

该代码必须从Access本身执行。 将两个代码粘贴到模块中，然后执行它。

希望您可以适应您的需求。

Answer 2

内置了打印或导出结构的功能以进行访问。

在功能区中的数据库工具下，选择数据库文档管理器。

选择表选项卡，选择要报告的表。

在点击确定之前，请确保您点击以下选项：

结果如下：

在查看以上内容时，您可以打印，甚至导出到excel。