Office中国论坛/Access中国论坛

标题: 一个关于导出到word的问题，感谢todaynow的热心回复 [打印本页]

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

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

作者: todaynew 时间: 2011-4-13 14:28
本帖最后由 todaynew 于 2011-4-13 14:31 编辑

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

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

作者: 笑夕阳 时间: 2011-4-13 14:56
本帖最后由笑夕阳于 2011-4-13 14:57 编辑

回复 todaynew 的帖子

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

作者: cumtlaw 时间: 2011-4-13 15:27
思路很好啊。

作者: cumtlaw 时间: 2011-4-13 15:27
不知道能不能实现啊。

作者: 笑夕阳 时间: 2011-4-13 15:30
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的思路是一样的。

作者: 笑夕阳 时间: 2011-4-13 15:30
里面还有代码看不懂

作者: 笑夕阳 时间: 2011-4-13 15:33
http://www.accessoft.com/article-show.asp?id=232
找到这个了，可以参照了

作者: 笑夕阳 时间: 2011-4-13 17:01
还是没有弄明白，todaynow可以做个简单的例子吗，万分感谢，自己研究了2个小时没有弄明白
各种问题接踵而来

作者: 笑夕阳 时间: 2011-4-13 17:02
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

作者: 笑夕阳 时间: 2011-4-13 17:02
现在告诉我的问题是”语法错误（操作符丢失）在查询表达式‘项目编号=’中

作者: todaynew 时间: 2011-4-13 17:15
本帖最后由 todaynew 于 2011-4-13 17:19 编辑

缺点操作符
Me.项目编号

最好写成：
Set rstDetails = CurrentDb.OpenRecordset("SELECT * FROM 发票明细表 WHERE 项目编号=" & nz(Me.项目编号.value,0)

避免Me.项目编号.value=null时跳错。

作者: 笑夕阳 时间: 2011-4-13 17:19
解决了，感谢大家，我把代码发上来
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 '将数据导出到此文件
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 = objDoc.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

作者: 笑夕阳 时间: 2011-4-13 17:21
用select那个SQL把我弄晕了，还是这个我容易理解，SQL语句老出错⊙﹏⊙b汗谢谢todaynow，厉害啊一个、都看到了

作者: todaynew 时间: 2011-4-13 17:25

笑夕阳发表于 2011-4-13 17:19
解决了，感谢大家，我把代码发上来
Private Sub 常规报告_Click()
DoCmd.RunCommand acCmdSaveRecord ...

应该将查找替换功能独立写为函数：
function 查找替换(doc as Word.Document,str0 as string,str1 as string)
with doc.selection.find
.text=str0
.replacement.text=str1
end with
end function

这样在文档中写多个字段时，可以通过遍历fileds对象的名称和值，循环对word文档做查找替换动作。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)