VBA(?):将Microsoft Access数据库记录到数据集(列表/字段/带有字段的查询)

时间:2019-03-15 10:18:30

标签: vba ms-access access-vba

寻找一种可以获取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迁移到更严重的数据库的一个令人惊叹的起点,对此深表感谢。

2 个答案:

答案 0 :(得分:1)

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

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

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

奖励:是的,它也将获得查询的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本身执行代码。将两个代码都粘贴到模块中,然后执行。

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

答案 1 :(得分:0)

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

从功能区的数据库工具下,选择数据库文档管理器。

选择表格标签,选择要报告的表格。

点击确定之前,请确保点击以下选项:

enter image description here

结果如下:

enter image description here 查看以上内容时,您可以打印,甚至导出到excel。