在ACCESS中导出所有数据表字段、外键关系。

Option Compare Database
Option Explicit

' 将只在“引用方（子表）的字段”行显示它引用的“被引用方（父表.字段）”。
Public Sub ExportTableStructure_ChildFKsOnly()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim rel As DAO.Relation
    Dim rf As DAO.Field
    Dim fkMap As Object
    Dim xlApp As Object, xlWB As Object, xlWS As Object
    Dim rowNum As Long
    Dim leftKey As String, rightKey As String
    Dim childKey As String, parentKey As String
    Dim leftIsPK As Boolean, rightIsPK As Boolean
    Dim debugMode As Boolean

    debugMode = False ' 如需调试改为 True（将在即时窗口输出判断信息）

    Set db = CurrentDb
    Set fkMap = CreateObject("Scripting.Dictionary")

    ' ==== 收集映射：只记录 子表字段 -> 父表字段 ====
    For Each rel In db.Relations
        If Left(rel.Name, 4) <> "MSys" Then
            For Each rf In rel.Fields
                leftKey = rel.Table & "." & rf.Name
                rightKey = rel.ForeignTable & "." & rf.ForeignName

                leftIsPK = IsFieldInPrimaryIndex(db, rel.Table, rf.Name)
                rightIsPK = IsFieldInPrimaryIndex(db, rel.ForeignTable, rf.ForeignName)

                ' 判断哪一侧更像“父表（主键）”，另一侧就是子表（外键）
                If rightIsPK And Not leftIsPK Then
                    childKey = leftKey: parentKey = rightKey
                ElseIf leftIsPK And Not rightIsPK Then
                    childKey = rightKey: parentKey = leftKey
                Else
                    ' 若两侧都不是/或两侧都是主键，回退到 DAO 的常见约定：把 rel.Table 视为“子表”
                    childKey = leftKey: parentKey = rightKey
                End If

                If debugMode Then
                    Debug.Print "Rel=" & rel.Name & " pair:" & leftKey & "<->" & rightKey & _
                                " leftIsPK=" & leftIsPK & " rightIsPK=" & rightIsPK & _
                                " -> child=" & childKey & " parent=" & parentKey
                End If

                If fkMap.Exists(childKey) Then
                    fkMap(childKey) = fkMap(childKey) & "; " & parentKey
                Else
                    fkMap.Add childKey, parentKey
                End If
            Next rf
        End If
    Next rel

    ' ==== 写入 Excel ====
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    Set xlWS = xlWB.Sheets(1)
    On Error Resume Next
    xlWS.Name = "表结构"
    On Error GoTo 0
    xlWS.Range("A1:D1").Value = Array("表名", "字段名称", "数据类型", "外键关系")
    rowNum = 2

    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 1) <> "~" Then
            For Each fld In tdf.Fields
                xlWS.Cells(rowNum, 1).Value = tdf.Name
                xlWS.Cells(rowNum, 2).Value = fld.Name
                xlWS.Cells(rowNum, 3).Value = FieldTypeName(fld.Type)
                If fkMap.Exists(tdf.Name & "." & fld.Name) Then
                    xlWS.Cells(rowNum, 4).Value = fkMap(tdf.Name & "." & fld.Name)
                Else
                    xlWS.Cells(rowNum, 4).Value = ""
                End If
                rowNum = rowNum + 1
            Next fld
        End If
    Next tdf

    MsgBox "导出完成！", vbInformation
End Sub

' 判断某表的某字段是否属于该表的主键索引（Primary Index）
Private Function IsFieldInPrimaryIndex(db As DAO.Database, tableName As String, fieldName As String) As Boolean
    On Error GoTo ErrHandle
    Dim tdf As DAO.TableDef
    Dim idx As DAO.Index
    Dim idxFld As DAO.Field
    Set tdf = db.TableDefs(tableName)
    For Each idx In tdf.Indexes
        If idx.Primary Then
            For Each idxFld In idx.Fields
                If idxFld.Name = fieldName Then
                    IsFieldInPrimaryIndex = True
                    Exit Function
                End If
            Next idxFld
        End If
    Next idx
    Exit Function
ErrHandle:
    ' 表不存在或无索引时视为 False
    IsFieldInPrimaryIndex = False
    Err.Clear
End Function

Private Function FieldTypeName(TypeCode As Integer) As String
    Select Case TypeCode
        Case dbBoolean: FieldTypeName = "Yes/No"
        Case dbByte: FieldTypeName = "Byte"
        Case dbInteger: FieldTypeName = "Integer"
        Case dbLong: FieldTypeName = "Long Integer"
        Case dbCurrency: FieldTypeName = "Currency"
        Case dbSingle: FieldTypeName = "Single"
        Case dbDouble: FieldTypeName = "Double"
        Case dbDate: FieldTypeName = "Date/Time"
        Case dbText: FieldTypeName = "Text"
        Case dbLongBinary: FieldTypeName = "OLE Object"
        Case dbMemo: FieldTypeName = "Memo"
        Case Else: FieldTypeName = "Other(" & TypeCode & ")"
    End Select
End Function