Access 导入 Markdown 表格：把文档里的数据写进表

摘要： 前面做了 Access 导出 Markdown，这次反过来，读取 .md 文件中的表格，按表头把数据追加到 Access 暂存表。标题、正文和代码块不导入，列数不一致时提示文件行号，写入失败则回滚。access开发|access培训|access框架|请添加edonsoft。

Hi，大家好！

各位十一假期有没有出去玩？还是堵在路上了？不管怎样，假期一定要开心！

之前写了《Access 表和查询导出 Markdown 文件，不用再复制粘贴》，把数据库里的记录保存成 .md 文件。有了导出，也就会想到：别人整理好的 Markdown 表格，能不能再读回 Access？

可以，不过我们这次只读表格里的数据。文档标题、说明文字、列表，不往数据库里放；代码块里展示的表格示例也跳过。

比如 AI 整理了一份产品清单，或者同事在文档里补了几条客户资料，把这些行导进来，就不用对着文档逐条录入。导入之前还是要看一遍，特别是 AI 生成的名称、编号和金额，格式正确不代表内容正确。

我一般先导进暂存表，不直接往客户主表里追加。确认没有重复、字段也没串列，再用查询处理正式数据。

下面按操作顺序来：先保存 Markdown 文件，再建暂存表、放入代码，最后执行导入。跑通之后，再接到窗体按钮。

第一步：准备 Markdown 文件

先打开要使用的 Access 数据库，确认它已经保存为 .accdb 文件。然后用记事本新建一个文本文件，把下面的内容放进去：

# 客户清单

以下是待核对的客户资料。

| 客户名称 | 地区 | 备注 |
| --- | --- | --- |
| XXX贸易 | 上海 | 月结客户 |
| XXX科技 | 北京 | 配件\|耗材 |

在记事本里选择「文件 → 另存为」，保存到这个 Access 数据库所在的文件夹。文件名填 客户清单.md，保存类型选「所有文件」，编码选「UTF-8」。确认实际文件名不是 客户清单.md.txt。

上面只是展示文件内容，真正保存时不要把外面的三个反引号也写进去，否则会被当成代码块跳过。

导入结果是两条记录。配件\|耗材 写入 Access 后变成 配件|耗材，不会被拆成两列。第二行的 ---、---:、:---: 都是表格格式说明，不是业务数据。

为了让规则明确，下面的代码要求每一行首尾都有 |，读取代码块外的第一张表格。同一个文件还有第二张表时，不会一起追加；可以把它单独存成另一个文件再导。

单元格里的 **重点**、链接语法、<br> 会按原文字保存，不做富文本转换。它也不处理 HTML 表格、跨行单元格或代码块单元格。这是一个固定格式的数据导入函数，不是完整的 Markdown 排版解析器。

第二步：在 Access 里建暂存表

回到 Access，选择「创建 → 表设计」，按下面的定义添加字段。选中 导入ID，单击「主键」，然后保存，表名填写 md客户导入。先不要用正式客户表测试。

字段名	数据类型	设置
导入ID	自动编号	主键，Markdown 中不提供这一列
客户名称	短文本	字段大小 100
地区	短文本	字段大小 50
备注	长文本	文本格式设为纯文本

第三步：新建标准模块，放入导入代码

按 Alt + F11 打开 VBA 编辑器，选择「插入 → 模块」。按 F4 打开属性窗口，把模块的「名称」改为 basImportMarkdownTable。

下面是这个模块的完整代码。新模块里如果已经有 Option Compare Database 等默认内容，先删除，再整段粘贴，避免重复。不要放到窗体模块里。

代码使用 DAO。现代 .accdb 项目通常已经引用 Access database engine Object Library；如果提示找不到 DAO.Database 类型，到「工具 → 引用」检查该引用。UTF-8 读取使用后期绑定的 ADODB.Stream，不需要再勾 ADO 引用。

Option Compare Database
Option Explicit

Public Function ImportMarkdownTable(ByVal filePath As String, _
                                    ByVal tableName As String) As Long
    On Error GoTo Failed
    Dim database As DAO.Database
    Dim workspace As DAO.Workspace
    Dim tableDef As DAO.TableDef
    Dim records As DAO.Recordset
    Dim field As DAO.Field
    Dim rows As Collection
    Dim headers As Variant
    Dim cells As Variant
    Dim names As Object
    Dim columnIndex As Long
    Dim rowIndex As Long
    Dim count As Long
    Dim inTransaction As Boolean
    Dim errorNumber As Long
    Dim errorText As String

    Set rows = ReadMdTable(ReadMdUtf8(filePath), headers)
    Set database = CurrentDb
    Set workspace = DBEngine.Workspaces(0)
    Set tableDef = database.TableDefs(tableName)
    If (tableDef.Attributes And dbAttachedTable) <> 0 Or _
       (tableDef.Attributes And dbAttachedODBC) <> 0 Or _
       (tableDef.Attributes And dbSystemObject) <> 0 Then
        Err.Raise vbObjectError + 5301, , "请使用本地暂存表。"
    End If

    Set names = CreateObject("Scripting.Dictionary")
    names.CompareMode = vbTextCompare
    For columnIndex = 0 To UBound(headers)
        If Len(headers(columnIndex)) = 0 Then
            Err.Raise vbObjectError + 5302, , "表头不能留空。"
        End If
        If names.Exists(headers(columnIndex)) Then
            Err.Raise vbObjectError + 5303, , "表头重复：" & headers(columnIndex)
        End If
        names.Add headers(columnIndex), True
        Set field = tableDef.Fields(CStr(headers(columnIndex)))
        If field.Type <> dbText And field.Type <> dbMemo Then
            Err.Raise vbObjectError + 5304, , "暂存字段必须是文本类型：" & field.Name
        End If
    Next columnIndex

    Set records = database.OpenRecordset(tableName, dbOpenDynaset)
    workspace.BeginTrans
    inTransaction = True
    For rowIndex = 1 To rows.Count
        cells = rows(rowIndex)
        records.AddNew
        For columnIndex = 0 To UBound(headers)
            Set field = records.Fields(CStr(headers(columnIndex)))
            If Len(cells(columnIndex)) = 0 Then
                field.Value = Null
            Else
                If field.Type = dbText Then
                    If Len(cells(columnIndex)) > field.Size Then
                        Err.Raise vbObjectError + 5305, , _
                            "数据第 " & rowIndex & " 行，字段「" & field.Name & "」超过长度限制。"
                    End If
                End If
                field.Value = cells(columnIndex)
            End If
        Next columnIndex
        records.Update
        count = count + 1
    Next rowIndex
    workspace.CommitTrans
    inTransaction = False
    records.Close
    ImportMarkdownTable = count
    Exit Function

Failed:
    errorNumber = Err.Number
    errorText = Err.Description
    On Error Resume Next
    If inTransaction Then
        workspace.Rollback
    End If
    If Not records Is Nothing Then
        records.Close
    End If
    On Error GoTo 0
    Err.Raise errorNumber, "ImportMarkdownTable", errorText
End Function

Private Function ReadMdUtf8(ByVal filePath As String) As String
    On Error GoTo Failed
    Dim stream As Object
    Dim errorNumber As Long
    Dim errorText As String
    Set stream = CreateObject("ADODB.Stream")
    stream.Type = 2
    stream.Charset = "utf-8"
    stream.Open
    stream.LoadFromFile filePath
    ReadMdUtf8 = stream.ReadText(-1)
    stream.Close
    If Left$(ReadMdUtf8, 1) = ChrW(&HFEFF) Then
        ReadMdUtf8 = Mid$(ReadMdUtf8, 2)
    End If
    Exit Function
Failed:
    errorNumber = Err.Number
    errorText = Err.Description
    On Error Resume Next
    If Not stream Is Nothing Then
        stream.Close
    End If
    On Error GoTo 0
    Err.Raise errorNumber, "ReadMdUtf8", errorText
End Function

Private Function ReadMdTable(ByVal markdown As String, ByRef headers As Variant) As Collection
    Dim lines As Variant
    Dim lineIndex As Long
    Dim currentLine As String
    Dim previousLine As String
    Dim fenceCharacter As String
    Dim fenceLength As Long
    Dim markerLength As Long
    Dim cells As Variant
    Dim separators As Variant
    Dim found As Boolean
    Dim rows As Collection
    Set rows = New Collection
    markdown = Replace(markdown, vbCrLf, vbLf)
    markdown = Replace(markdown, vbCr, vbLf)
    lines = Split(markdown, vbLf)

    For lineIndex = 0 To UBound(lines)
        currentLine = Trim$(lines(lineIndex))
        If Len(fenceCharacter) > 0 Then
            markerLength = MdFenceLength(currentLine, fenceCharacter)
            If markerLength >= fenceLength Then
                If Len(Trim$(Mid$(currentLine, markerLength + 1))) = 0 Then
                    fenceCharacter = ""
                End If
            End If
            previousLine = ""
        Else
            markerLength = MdFenceLength(currentLine, "`")
            If markerLength < 3 Then
                markerLength = MdFenceLength(currentLine, "~")
            End If
            If markerLength >= 3 Then
                If found Then
                    Exit For
                End If
                fenceCharacter = Left$(currentLine, 1)
                fenceLength = markerLength
                previousLine = ""
            ElseIf found Then
                If Not IsMdPipeRow(currentLine) Then
                    Exit For
                End If
                cells = SplitMdRow(currentLine)
                If UBound(cells) <> UBound(headers) Then
                    Err.Raise vbObjectError + 5306, , _
                        "文件第 " & (lineIndex + 1) & " 行的列数与表头不一致。"
                End If
                rows.Add cells
            Else
                If IsMdPipeRow(currentLine) And IsMdPipeRow(previousLine) Then
                    separators = SplitMdRow(currentLine)
                    If IsMdSeparator(separators) Then
                        headers = SplitMdRow(previousLine)
                        If UBound(headers) <> UBound(separators) Then
                            Err.Raise vbObjectError + 5307, , "表头和分隔行的列数不一致。"
                        End If
                        found = True
                    End If
                End If
                previousLine = currentLine
            End If
        End If
    Next lineIndex
    If Not found Then
        Err.Raise vbObjectError + 5308, , "文件中没有符合格式的 Markdown 表格。"
    End If
    Set ReadMdTable = rows
End Function

Private Function MdFenceLength(ByVal line As String, ByVal marker As String) As Long
    Dim position As Long
    For position = 1 To Len(line)
        If Mid$(line, position, 1) <> marker Then
            Exit For
        End If
        MdFenceLength = position
    Next position
End Function

Private Function IsMdPipeRow(ByVal line As String) As Boolean
    IsMdPipeRow = Len(line) >= 2 And Left$(line, 1) = "|" And Right$(line, 1) = "|"
End Function

Private Function SplitMdRow(ByVal line As String) As Variant
    Dim parts As Collection
    Dim result() As String
    Dim body As String
    Dim cell As String
    Dim character As String
    Dim position As Long
    Dim partIndex As Long
    Set parts = New Collection
    body = Mid$(line, 2, Len(line) - 2)
    position = 1
    Do While position <= Len(body)
        character = Mid$(body, position, 1)
        If character = "\" And Mid$(body, position + 1, 1) = "|" Then
            cell = cell & "|"
            position = position + 2
        Else
            If character = "|" Then
                parts.Add Trim$(cell)
                cell = ""
            Else
                cell = cell & character
            End If
            position = position + 1
        End If
    Loop
    parts.Add Trim$(cell)
    ReDim result(0 To parts.Count - 1)
    For partIndex = 1 To parts.Count
        result(partIndex - 1) = parts(partIndex)
    Next partIndex
    SplitMdRow = result
End Function

Private Function IsMdSeparator(ByVal cells As Variant) As Boolean
    Dim columnIndex As Long
    Dim value As String
    For columnIndex = 0 To UBound(cells)
        value = cells(columnIndex)
        If Left$(value, 1) = ":" Then
            value = Mid$(value, 2)
        End If
        If Right$(value, 1) = ":" Then
            value = Left$(value, Len(value) - 1)
        End If
        If Len(value) < 3 Or Len(Replace(value, "-", "")) > 0 Then
            Exit Function
        End If
    Next columnIndex
    IsMdSeparator = True
End Function

按 Ctrl + S 保存模块，再选择「调试 → 编译」检查代码。如果提示找不到 DAO.Database 类型，按前面的说明检查 DAO 引用，然后重新编译。

这里没有用 Split(一行, "|") 直接分列。因为 配件\|耗材 里的竖线是数据的一部分，必须识别反斜杠再决定它是不是分隔符。这个分列函数按上一篇导出函数的 \| 写法处理，其他反斜杠保持原样，不展开全部 Markdown 转义规则。

第四步：执行导入，检查表里的数据

确认第一步保存的 客户清单.md 和数据库在同一个文件夹。在 VBA 编辑器里按 Ctrl + G 打开立即窗口，输入下面这行，按回车执行：

? ImportMarkdownTable(CurrentProject.Path & "\客户清单.md", "tmp客户导入")

立即窗口显示 2，表示追加了两条记录。按 Alt + F11 回到 Access，在导航窗格里双击 tmp客户导入，应能看到 XXX贸易 和 XXX科技，后者的备注应是 配件|耗材。如果表已经打开，关闭后重新打开再检查。

想检查错误处理，可以回到记事本，把其中一行少写一列，保存后再执行同一行导入命令。函数应提示文件行号，暂存表不增加记录。把客户名称改成超过 100 个字符，写入时会报长度错误，本次已经追加的记录也会回滚，原来表里的数据保留。测试完把文件改回原样。

这个函数只追加，不清空表、不修改旧记录。对同一文件运行两遍，就会导入两遍；确认结果后再导正式表时，需要自己按客户编号等业务键查重。正式数据操作前先备份，也不要把这个带事务的函数嵌入另一个尚未结束的 DAO 事务。

第五步：接到窗体按钮（可选）

前四步完成后，已经可以导入数据。这一步是让用户通过按钮操作，不用每次打开立即窗口。

把要使用的窗体打开为设计视图，添加一个命令按钮；如果弹出按钮向导，先取消向导。选中按钮，按 F4 打开属性表，把「名称」设为 btn导入Markdown，「标题」设为「导入 Markdown」。

切到属性表的「事件」页，将「单击」设为「事件过程」，单击右侧的「...」进入代码编辑器，用下面的代码替换自动生成的空单击事件过程：

Private Sub btn导入Markdown_Click()
    On Error GoTo Failed
    Dim imported As Long
    imported = ImportMarkdownTable(CurrentProject.Path & "\客户清单.md", "md客户导入")
    MsgBox "本次导入 " & imported & " 条记录。", vbInformation
    Exit Sub
Failed:
    MsgBox Err.Description, vbExclamation
End Sub

保存代码和窗体，切换到窗体视图，单击「导入 Markdown」。正常时会提示「本次导入 2 条记录」，文件或表格有问题时会显示错误说明。

这里仍然读取数据库同目录下的 客户清单.md。如果第四步已经导入过，再点按钮就会再追加两条，不是覆盖前面的记录。

导回去不等于还原原数据库

上一篇的导出代码会把备注中的换行换成空格，超过设定长度的文字会截短，空值也不会保留原来的详细类型。OLE、附件只是写一个文字提示。这些信息一旦在导出时省掉，导入函数没办法找回来。

所以这套做法适合接收清单、暂存文档中的数据，不适合数据库备份。需要原样保留完整字段值时，用 Access 表导出、数据库备份或其他保留类型的交换方式。

另外，Markdown 没有告诉我们某列到底是日期、金额还是客户编号。这也是先放文本暂存表的原因。比如日期要求 yyyy-mm-dd，金额是否带千位分隔符，都应先约定，再写转换查询；不能看到一个数字就自动决定它是金额。

从文档到 Access，这一步只做两件事：把表格读准，把原文字写到对应字段。后面的去重、关联和类型转换，按自己的业务表来处理。