一个关于导出到word的问题，感谢todaynow的热心回复

笑夕阳

在论坛已经有些日子了，感觉这里很多东西自己没有消化，但是渐渐的学习了很多知识，感谢【access小品】系列给我的帮助，我有个问题一直没有办法解决，看过todaynow的导入word的表格中，这个现在我在用了，但是如何将制定的文字导入到非表格的word文档中，是否有除了邮件合并的VBA的办法呢？邮件合并每次发给同事的时候会提示连接SQL数据库，很不方便，及时增加了注册表选项取消提示，也会发生伴随同事数据库内容不同邮件发现变化。
昨天试探着发邮件给todaynow版主，感谢回复。

问题：如何将access中的字段导入到word文本中指定的位置中？

todaynew

笑夕阳 发表于 2011-4-13 12:50
在论坛已经有些日子了，感觉这里很多东西自己没有消化，但是渐渐的学习了很多知识，感谢【access小品】系列 ...

处理方法很多：比如先在word模板中标识出各个字段的导入的位置（比如用“【企业名称】”类似这样的标识），VB代码遍历word模版时找到该标识，然后用字段数据替换掉该标识。也可以通过代码从Access或者word执行word的查找替换功能，对特定字符进行替换。
.

笑夕阳

回复 todaynew 的帖子

⊙﹏⊙b汗，看不懂，我属于VB盲...我想想看，谢谢todaynew

cumtlaw

思路很好啊。

cumtlaw

不知道能不能实现啊。

笑夕阳

sqlStr = "select * from Policy_SP_Clause where [policy_sbj_id]='" & Me.id.Value & "'"
    Set rs = CurrentDb.OpenRecordset(sqlStr)
        For N = 1 To 8    '8条Clause明细记录处理
        policy_sublimits = rs.Fields("policy_sublimits")
        clause_descr_en = rs.Fields("clause_descr_en")
        
            .Text = "[" & "policy_sublimits" & N & "]"
            .Replacement.Text = Nz(IIf(rs.EOF, "", policy_sublimits), "")
'          .Replacement.Text = Nz(IIf(rs.EOF, "", rs!policy_sublimits), "")
            .Execute , , , , , , , , , , 2    '全部查找和替换

            .Text = "[" & "clause_descr_en" & N & "]"
            .Replacement.Text = Nz(IIf(rs.EOF, "", clause_descr_en), "")
'           .Replacement.Text = Nz(IIf(rs.EOF, "", rs!clause_descr_en), "") '直接读取仍不行
            .Execute , , , , , , , , , , 2
            If Not rs.EOF Then rs.MoveNext
            Next
找到这个内容，和todaynow的思路是一样的。

笑夕阳

里面还有代码看不懂

笑夕阳

http://www.accessoft.com/article-show.asp?id=232
找到这个了，可以参照了

笑夕阳

还是没有弄明白，todaynow可以做个简单的例子吗，万分感谢，自己研究了2个小时没有弄明白
各种问题接踵而来

笑夕阳

Private Sub 常规报告_Click()
DoCmd.RunCommand acCmdSaveRecord    '打印前先保存记录

On Error GoTo Err_cmdExportToWord_Click
    Dim objApp          As Object 'Word.Application
    Dim objDoc          As Object 'Word.Document
    Dim win             As Object 'Word.窗口
    Dim doc             As Object
    Dim docApp          As Object
    Dim strTemplates    As String '模板文件路径名
    Dim strFileName     As String '将数据导出到此文件
     Dim rstDetails As DAO.Recordset

    Set rstDetails = CurrentDb.OpenRecordset("SELECT 报告编号, 规格型号, 计量单位, 数量, 单价, 金额, 备注 FROM 发票明细表 WHERE 项目编号=" & Me项目编号)

    '如果没有记录 , 不执行下面程序
    If rstDetails.EOF Then Exit Sub

    If Me.NewRecord Then
        MsgBox "当前没有可导出的数据。", vbInformation, "提示"
        Exit Sub
    End If
   
    strTemplates = CurrentProject.Path & "\常规项目报告模板.dotx"
   
    '通过文件对话框生成另存为文件名
    With FileDialog(2)  'msoFileDialogSaveAs
        .InitialFileName = CurrentProject.Path & "\常规项目报告模板.doc"
        If .Show Then strFileName = .SelectedItems(1)
    End With
   
    '如果对话框被取消，则变量没有被赋值，退出过程
    If strFileName = "" Then Exit Sub
   
    '文件名必须包括“.doc”的文件扩展名，如没有则自动加上
    If Not strFileName Like "*.doc" Then strFileName = strFileName & ".doc"
    '如果文件已存在，则删除已有文件
    If Dir(strFileName) <> "" Then Kill strFileName
   
    '将光标设置为沙漏形，以示正在执行程序
    DoCmd.Hourglass True
   
    '打开模板文件
    Set objApp = CreateObject("Word.Application") 'createObject("类名")
    objApp.Visible = True
    Set objDoc = objApp.Documents.Open(strTemplates, , True)
    Set win = doc.ActiveWindow
   With win.Selection.Find    '使用查找和替换

            .Text = "[报告编号]"
            .Replacement.Text = Nz(Me.报告编号)
            .Execute , , , , , , , , , , 2  '全部替换
        End With
   
    '将写入数据的模板另存为文档文件
    objDoc.SaveAs strFileName
    objDoc.Saved = True
   
Exit_cmdExportToWord_Click:
    If Not objDoc Is Nothing Then objApp.Visible = True
    '恢复光标形状
    DoCmd.Hourglass False
    Set objApp = Nothing
    Set objDoc = Nothing
    Set objTable = Nothing
    Exit Sub
   
Err_cmdExportToWord_Click:
    MsgBox Err.Description, vbCritical, "出错"
    Resume Exit_cmdExportToWord_Click
    End Sub