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