Access 里的表和查询，怎么直接存成 Markdown 文件？

摘要： 上一篇是把表结构生成 Markdown 文本，这篇直接存成 UTF-8 的 .md 文件，点按钮就能导出。access开发|access培训|access框架|请添加edonsoft。

Hi，大家好！

之前我写过一篇文章《把 Access 数据变成 Markdown，可能是接入 AI 前最实用的一步》，做的是把表结构和几十行样例拼成一段文字，在立即窗口里 Debug.Print，或者塞进文本框，再复制给 AI。

用过的人接着问：能不能直接存成文件？表里的数据也一起导出去，不用每次复制。

这个当然是可以。采购要库存周报，把查询导成 .md，往钉钉、企业微信里一贴就是表格。项目说明要放进 Git，表名、字段、当前数据不用再手抄。给同事发清单，也比发一个 Excel 省事，打开就是文本。

如果需要把文件喂给AI，很明显Excel是花费更多的token。

下面做的事很具体：选表或查询，生成 Markdown，用 ADODB.Stream 按 UTF-8 存成 .md。

导出长什么样

假设有张 客户表，导出来的文件大概是这样：

# 客户表

- 来源：表
- 导出时间：2026-09-22 09:30
- 记录数：128
- 本次导出：128 行

| 客户ID | 客户名称 | 地区 | 余额 |
| ---: | --- | --- | ---: |
| 1 | 华东贸易 | 上海 | 12800.00 |
| 2 | 北辰科技 | 北京 | 5600.00 |

OLE、附件这类字段转不成字，单元格里就写 (二进制)。

模块放哪

VBA 编辑器里插入标准模块，名字用 basExportMarkdown。下面整段复制进去。ADODB.Stream 用 CreateObject，不用先勾 Microsoft ActiveX Data Objects 引用。

Option Compare Database
Option Explicit

Private Const adTypeText As Long = 2
Private Const adSaveCreateOverWrite As Long = 2

' 把表或查询导出为 UTF-8 的 .md 文件
' sFilePath 留空则弹出另存为
Public Sub ExportObjectToMarkdown(ByVal sObjectName As String, _
                                  Optional ByVal sFilePath As String = "", _
                                  Optional ByVal lMaxRows As Long = 5000)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sName As String
    Dim sKind As String
    Dim sMd As String
    Dim lTotal As Long

    sName = Trim$(sObjectName)
    If Len(sName) = 0 Then
        MsgBox "请先指定表名或查询名。", vbExclamation
        Exit Sub
    End If
    If lMaxRows < 1 Then lMaxRows = 5000

    Set db = CurrentDb
    sKind = ObjectKind(db, sName)
    If sKind = "未知对象" Then
        MsgBox "当前数据库没有名为「" & sName & "」的表或查询。请检查组合框返回的名称。", vbExclamation
        Exit Sub
    End If
    If Not CanExportKind(sKind) Then
        MsgBox "对象「" & sName & "」不能当记录源导出（类型：" & sKind & "）。", vbExclamation
        Exit Sub
    End If

    lTotal = RecordCountOf(db, sName)
    Set rs = db.OpenRecordset("SELECT TOP " & CStr(lMaxRows) & " * FROM " & BracketName(sName), dbOpenSnapshot)

    sMd = "# " & sName & vbCrLf & vbCrLf
    sMd = sMd & "- 来源：" & sKind & vbCrLf
    sMd = sMd & "- 导出时间：" & Format$(Now, "yyyy-mm-dd hh:nn") & vbCrLf
    sMd = sMd & "- 记录数：" & CStr(lTotal) & vbCrLf
    sMd = sMd & "- 本次导出：最多 " & CStr(lMaxRows) & " 行" & vbCrLf & vbCrLf
    sMd = sMd & RecordsetToMarkdown(rs)

    rs.Close
    Set rs = Nothing

    If Len(Trim$(sFilePath)) = 0 Then
        sFilePath = PickSavePath(sName & ".md")
        If Len(sFilePath) = 0 Then Exit Sub
    End If

    SaveUtf8 sFilePath, sMd
    MsgBox "已导出：" & vbCrLf & sFilePath, vbInformation
End Sub

Public Function RecordsetToMarkdown(ByVal rs As DAO.Recordset) As String
    Dim i As Long
    Dim lCol As Long
    Dim sLine As String
    Dim sOut As String
    Dim lRow As Long
    Dim fld As DAO.Field

    If rs Is Nothing Then
        RecordsetToMarkdown = "(无记录集)"
        Exit Function
    End If

    lCol = rs.Fields.Count
    If lCol = 0 Then
        RecordsetToMarkdown = "(无字段)"
        Exit Function
    End If

    sLine = "|"
    For i = 0 To lCol - 1
        sLine = sLine & " " & MdCell(rs.Fields(i).Name) & " |"
    Next i
    sOut = sLine & vbCrLf

    sLine = "|"
    For i = 0 To lCol - 1
        Set fld = rs.Fields(i)
        If IsNumericType(fld.Type) Then
            sLine = sLine & " ---: |"
        Else
            sLine = sLine & " --- |"
        End If
    Next i
    sOut = sOut & sLine & vbCrLf

    If rs.EOF And rs.BOF Then
        RecordsetToMarkdown = sOut & vbCrLf & "(无数据)" & vbCrLf
        Exit Function
    End If

    rs.MoveFirst
    Do While Not rs.EOF
        sLine = "|"
        For i = 0 To lCol - 1
            sLine = sLine & " " & FieldToCell(rs.Fields(i)) & " |"
        Next i
        sOut = sOut & sLine & vbCrLf
        lRow = lRow + 1
        rs.MoveNext
    Loop

    RecordsetToMarkdown = sOut
End Function

Private Function FieldToCell(ByVal fld As DAO.Field) As String
    Select Case fld.Type
        Case dbLongBinary, 101, 102, 103, 104, 105, 106, 107, 108, 109
            FieldToCell = "(二进制)"
        Case dbBoolean
            If IsNull(fld.Value) Then
                FieldToCell = ""
            ElseIf fld.Value Then
                FieldToCell = "是"
            Else
                FieldToCell = "否"
            End If
        Case dbDate
            If IsNull(fld.Value) Then
                FieldToCell = ""
            Else
                FieldToCell = Format$(fld.Value, "yyyy-mm-dd hh:nn:ss")
            End If
        Case Else
            FieldToCell = MdCell(fld.Value)
    End Select
End Function

Private Function MdCell(ByVal v As Variant, Optional ByVal lMaxLen As Long = 200) As String
    Dim s As String
    If IsNull(v) Then
        MdCell = ""
        Exit Function
    End If
    s = CStr(v)
    s = Replace(s, vbCrLf, " ")
    s = Replace(s, vbCr, " ")
    s = Replace(s, vbLf, " ")
    s = Replace(s, "|", "\|")
    If Len(s) > lMaxLen Then s = Left$(s, lMaxLen) & "..."
    MdCell = s
End Function

Private Function IsNumericType(ByVal lType As Long) As Boolean
    Select Case lType
        Case dbByte, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, 16
            IsNumericType = True
    End Select
End Function

Private Function BracketName(ByVal sName As String) As String
    BracketName = "[" & Replace(sName, "]", "]]") & "]"
End Function

Private Function ObjectKind(ByVal db As DAO.Database, ByVal sName As String) As String
    Dim tdf As DAO.TableDef
    Dim qdf As DAO.QueryDef

    For Each tdf In db.TableDefs
        If StrComp(tdf.Name, sName, vbTextCompare) = 0 Then
            If (tdf.Attributes And dbAttachedTable) <> 0 Or (tdf.Attributes And dbAttachedODBC) <> 0 Then
                ObjectKind = "链接表"
            ElseIf (tdf.Attributes And dbSystemObject) <> 0 Then
                ObjectKind = "系统表"
            Else
                ObjectKind = "表"
            End If
            Exit Function
        End If
    Next tdf

    For Each qdf In db.QueryDefs
        If StrComp(qdf.Name, sName, vbTextCompare) = 0 Then
            Select Case qdf.Type
                Case dbQSelect: ObjectKind = "选择查询"
                Case dbQCrosstab: ObjectKind = "交叉表查询"
                Case dbQSQLPassThrough: ObjectKind = "传递查询"
                Case dbQSetOperation: ObjectKind = "联合查询"
                Case dbQDelete, dbQUpdate, dbQAppend, dbQMakeTable: ObjectKind = "操作查询"
                Case Else: ObjectKind = "查询"
            End Select
            Exit Function
        End If
    Next qdf

    ObjectKind = "未知对象"
End Function

Private Function CanExportKind(ByVal sKind As String) As Boolean
    Select Case sKind
        Case "表", "链接表", "选择查询", "交叉表查询", "传递查询", "联合查询", "查询"
            CanExportKind = True
    End Select
End Function

Private Function RecordCountOf(ByVal db As DAO.Database, ByVal sName As String) As Long
    Dim rs As DAO.Recordset
    Set rs = db.OpenRecordset("SELECT Count(*) AS Cnt FROM " & BracketName(sName), dbOpenSnapshot)
    If Not rs.EOF Then RecordCountOf = CLng(Nz(rs!Cnt, 0))
    rs.Close
End Function

Private Function PickSavePath(ByVal sDefaultName As String) As String
    Dim fd As Object
    On Error GoTo NoDialog
    Set fd = Application.FileDialog(2) ' msoFileDialogSaveAs
    With fd
        .Title = "保存 Markdown"
        .AllowMultiSelect = False
        .InitialFileName = CurrentProject.Path & "\" & sDefaultName
        If .Show = -1 Then
            PickSavePath = .SelectedItems(1)
            If LCase$(Right$(PickSavePath, 3)) <> ".md" Then
                PickSavePath = PickSavePath & ".md"
            End If
        End If
    End With
    Exit Function
NoDialog:
    PickSavePath = CurrentProject.Path & "\" & sDefaultName
End Function

Private Sub SaveUtf8(ByVal sPath As String, ByVal sText As String)
    Dim stm As Object
    Set stm = CreateObject("ADODB.Stream")
    With stm
        .Type = adTypeText
        .Charset = "utf-8"
        .Open
        .WriteText sText
        .SaveToFile sPath, adSaveCreateOverWrite
        .Close
    End With
End Sub

FileDialog 在有些精简版 Office 里没有。代码里出错就存到当前数据库所在目录，文件名用表名，按钮不会因为没有另存为对话框就停住。

立即窗口先跑通

ExportObjectToMarkdown "客户表", CurrentProject.Path & "\客户表.md", 100

查询也一样：

ExportObjectToMarkdown "qry本周库存", CurrentProject.Path & "\本周库存.md", 2000

打开生成的 .md，用 VS Code 或记事本看。中文乱码，一般是用了 Open ... For Output，写成了系统 ANSI。记事本和 VS Code 默认按 UTF-8 打开，字就花了。保存用 ADODB.Stream，Charset 设成 utf-8。

窗体上放一个按钮

做一个小窗体 frm导出Markdown，三个控件：

控件	名称	说明
组合框	cbo对象	行来源见下面
文本框	txt最大行数	默认 2000
按钮	btn导出	单击事件

组合框行来源可以用：

SELECT Name FROM MSysObjects
WHERE Type In (1, 4, 5, 6)
  AND Left([Name], 4) <> "MSys"
  AND Left([Name], 1) <> "~"
ORDER BY Name

Type 里，1 是本地表，4 和 6 是不同类型的链接表，5 是查询。MSysObjects 打不开，就循环 TableDefs 和 QueryDefs 往组合框里加。MSys 开头和 ~ 开头的别列进去。

如果提示找不到表或查询，先在立即窗口执行 ? CurrentDb.QueryDefs("qry本周库存").Name，把名称换成组合框实际返回的值。这里仍报「这个集合中找不到项目」，说明它不是当前数据库里的保存查询；再核对组合框的绑定列，以及名称前后有没有空格。

按钮：

Private Sub btn导出_Click()
    Dim lMax As Long
    If IsNull(Me.cbo对象) Then
        MsgBox "先选表或查询。", vbExclamation
        Exit Sub
    End If
    lMax = CLng(Nz(Me.txt最大行数, 2000))
    ExportObjectToMarkdown CStr(Me.cbo对象), "", lMax
End Sub

第三个参数留空，会弹出另存为。每次都存到同一个目录，比如仓库里的 docs，把路径直接写上。

写表格时要注意的几处

备注里经常有回车。Markdown 表格不能在单元格里换行，不替换成空格，这一行后面的列全乱。字段内容里如果真有 |，要写成 \|，不然会被当成下一列。

日期看字段类型，fld.Type = dbDate 再 Format。别用 IsDate(值)，有的数字、文本也会被当成日期。

默认最多 5000 行。十万行的表直接 SELECT * 再拼字符串，Access 会卡很久。周报先做成查询，按日期筛完再导这个查询。

追加、更新、删除这类操作查询导不了，代码里会提示。传递查询能打开记录集就能导，打不开就会报错。

有的表不适合这么导

字段特别多，或者某一列特别长，导出来的表会横着拉很长，手机上看着费劲。这种还是导 Excel，或者一条记录写成一个小标题，别硬塞进一张表。

要打印、要盖章的，用报表或 Word。.md 就是给开发文档、数据快照、丢给 AI 用的。

几个人共用一个前端时，路径用 CurrentProject.Path，或者弹对话框让人自己选。写死 C:\Users\某某\Desktop，换台电脑就找不到。

上一篇的 BuildDbObjectContext 还是留着。那个只出字段类型和几行样例，给 AI 看表长什么样。这篇是把数据写成文件。两个按钮分开，别合成一个。

按钮接上就能用。周报如果要定时出，把 ExportObjectToMarkdown 挂到现有的启动或定时过程里，不用再写一套。