如何将Access查询数据导出至MS Word表格并插入指定位置？

核心解决方案 #

用Access VBA直接操作Word对象，定位到书签位置插入/填充表格，同时设置表格边框和日期字段下划线，兼容你现有表单域填充逻辑。

步骤1：准备Word模板 #

• 在需要插入数据表格的位置添加书签，命名为 InsertTableHere（可自定义）
• 确保模板中用于开结案日期的表单域已创建（你现有逻辑可直接复用）

步骤2：Access VBA代码实现 #

先在Access中引用Word对象库：工具 -> 引用 -> 勾选Microsoft Word xx.x Object Library，然后新建模块粘贴以下代码：

Sub ExportCaseDataToWord()
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim rs As DAO.Recordset
    Dim tbl As Word.Table
    Dim rowIdx As Integer, colIdx As Integer
    
    ' 打开Word模板（替换为你的模板实际路径）
    Set objWord = New Word.Application
    objWord.Visible = True ' 调试时保留，正式使用可设为False
    Set objDoc = objWord.Documents.Open("C:\Cases\CaseTemplate.docx")
    
    ' 填充开结案日期到表单域（替换为你的表单域名称和数据源）
    objDoc.FormFields("txtOpenDate").Result = Format(Forms!frmCaseManagement!OpenDate, "yyyy-MM-dd")
    objDoc.FormFields("txtCloseDate").Result = Format(Forms!frmCaseManagement!CloseDate, "yyyy-MM-dd")
    
    ' 读取Access查询数据（替换为你的查询名称）
    Set rs = CurrentDb.OpenRecordset("qryCaseDemographics")
    
    If Not rs.EOF Then
        ' 定位到书签位置，创建表格（行数=记录数+1表头，列数=字段数）
        objDoc.Bookmarks("InsertTableHere").Select
        Set tbl = objDoc.Tables.Add(Range:=objWord.Selection.Range, _
                                   NumRows:=rs.RecordCount + 1, _
                                   NumColumns:=rs.Fields.Count)
        
        ' 填充表头
        For colIdx = 0 To rs.Fields.Count - 1
            tbl.Cell(1, colIdx + 1).Range.Text = rs.Fields(colIdx).Name
            tbl.Cell(1, colIdx + 1).Range.Font.Bold = True
        Next colIdx
        
        ' 填充记录数据，日期字段加下划线
        rs.MoveFirst
        rowIdx = 2
        Do While Not rs.EOF
            For colIdx = 0 To rs.Fields.Count - 1
                tbl.Cell(rowIdx, colIdx + 1).Range.Text = Nz(rs.Fields(colIdx).Value, "")
                ' 判断日期字段，添加单下划线
                If rs.Fields(colIdx).Type = dbDate Then
                    tbl.Cell(rowIdx, colIdx + 1).Range.Font.Underline = wdUnderlineSingle
                End If
            Next colIdx
            rs.MoveNext
            rowIdx = rowIdx + 1
        Loop
        
        ' 设置表格边框
        tbl.Borders.OutsideLineStyle = wdLineStyleSingle
        tbl.Borders.InsideLineStyle = wdLineStyleSingle
        tbl.Borders.OutsideLineWidth = wdLineWidth150pt
        tbl.Borders.InsideLineWidth = wdLineWidth050pt
        
        ' 重新添加书签（避免后续操作丢失定位）
        objWord.Selection.Collapse wdCollapseEnd
        objDoc.Bookmarks.Add "InsertTableHere", objWord.Selection.Range
    Else
        ' 无数据时的提示
        objDoc.Bookmarks("InsertTableHere").Range.Text = "暂无相关人口统计数据"
    End If
    
    ' 释放资源（正式使用时取消注释）
    rs.Close
    Set rs = Nothing
    ' objDoc.SaveAs "C:\Cases\FinalCase_" & Forms!frmCaseManagement!CaseID & ".docx"
    ' Set objDoc = Nothing
    ' Set objWord = Nothing
End Sub

适配已有空白表格的场景 #

如果你的Word模板已经有带表头的空白表格，可将书签tblCaseData放在表格的第一个数据行，修改代码如下：

' 定位到已有表格
Set tbl = objDoc.Bookmarks("tblCaseData").Range.Tables(1)
rs.MoveFirst
Do While Not rs.EOF
    ' 新增数据行
    tbl.Rows.Add
    rowIdx = tbl.Rows.Count
    For colIdx = 0 To rs.Fields.Count - 1
        tbl.Cell(rowIdx, colIdx + 1).Range.Text = Nz(rs.Fields(colIdx).Value, "")
        If rs.Fields(colIdx).Type = dbDate Then
            tbl.Cell(rowIdx, colIdx + 1).Range.Font.Underline = wdUnderlineSingle
        End If
    Next colIdx
    rs.MoveNext
Loop
' 补全边框（如果模板表格未设置）
tbl.Borders.OutsideLineStyle = wdLineStyleSingle
tbl.Borders.InsideLineStyle = wdLineStyleSingle

关键说明 #

• 书签定位：通过Bookmarks("xxx").Select精准定位表格插入/填充位置
• 日期字段识别：利用DAO.Field.Type判断字段类型，动态添加下划线
• 空值处理：用Nz函数避免空字段导致单元格显示异常
• 表单域兼容：直接复用你现有FormFields赋值逻辑，无需额外修改

内容的提问来源于stack exchange，提问作者Drew Bee