24小时热门版块排行榜    

查看: 1318  |  回复: 3
当前只显示满足指定条件的回帖,点击这里查看本话题的所有回帖

wilstar

金虫 (正式写手)

[求助] 麻烦给段vba代码,实现access数据自动导入到word中

在网上找了个access文件,想实现文档的批量替换,详见附件
麻烦给段vba代码,实现access数据自动导入到word中
其中,通知单模板.doc位于模板文件夹内,存放位置给的是例子
在使用的时候就发现,其中的窗体域就类似于书签,见如下图
麻烦给段vba代码,实现access数据自动导入到word中-1
这就存在一个问题,书签的话,一个模板中只能采用一个,换言之,就是同样的标记只能使用一次,同样的内容可能在文件中出现多次,这样这个模板就用不起了
在网上看到别的用下图的书签就实现了同一文本的多次自动填写
麻烦给段vba代码,实现access数据自动导入到word中-2
但苦于看不到相应的代码,只能干着急
麻烦哪位高手指点一下,或者给个能够实现的代码或方式,以实现数据在word中的批量多次导出或者叫填充,在此谢过了

最后附上access文件中的“导出word的代码”
CODE:
Private Sub 导出word_Click()
    On Error GoTo ErrorHandler
    Dim strTemplate As String
    Dim strFileName As String
    Dim objApp As Object    'New Word.Application
    Dim objDoc As Object    'Word.Document
    Dim objField As Object    'Word.Field
    Dim rst As Object
    Dim blnNoQuit As Boolean

    strTemplate = CurrentProject.Path & "\模板\通知单模板.doc"


    '设置鼠标指针为沙漏形状
    DoCmd.Hourglass True

    Set objApp = CreateObject("Word.Application")
    Set objDoc = objApp.Documents.Open(strTemplate)
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tbl通知单 WHERE ID=" & ID, , 4)    'dbReadOnly
    If Not rst.EOF Then
        strFileName = CurrentProject.Path & "\存放位置\" & "通知单" & rst!ID & ".doc"
        '如果文件已存在,先删除已有文件
        If Dir(strFileName) <> "" Then Kill strFileName
        objDoc.FormFields("钢筋绑扎胎具").result = rst!钢筋绑扎胎具
        objDoc.FormFields("桥梁名称").result = rst!桥梁名称
        objDoc.FormFields("箱梁编号").result = rst!箱梁编号
        objDoc.FormFields("份数").result = Nz(rst!份数)
        objDoc.FormFields("钢筋吊装时间").result = Format(rst!钢筋吊装时间, "yyyy年m月d日")
        objDoc.FormFields("交接人").result = rst!交接人
        objDoc.FormFields("字段1").result = rst!字段1
    End If
    rst.Close
    objDoc.SaveAs strFileName
    Beep
    If MsgBox("导出已完成,是否打开该文件?", vbQuestion + vbYesNo, "导出完成") = vbYes Then
        objApp.Visible = True
        objDoc.Saved = True
        blnNoQuit = True
    End If

ExitHere:
    On Error Resume Next
    If Not blnNoQuit Then
        If Not objDoc Is Nothing Then objDoc.Saved = True
        If Not objApp Is Nothing Then objApp.Quit
    End If
    '恢复鼠标指针
    DoCmd.Hourglass False
    '释放对象变量内存
    Set objApp = Nothing
    Set objDoc = Nothing
    Set rst = Nothing
    Exit Sub

ErrorHandler:        '错误处理程序
    If Err = 70 Then
        MsgBox "不能替换文件,因为无法删除已有文件,可能的原因有:" & vbCrLf & vbCrLf & _
               "1.该文件处于打开状态。" & vbCrLf & _
               "2.没有对此目录的写入权限。", vbCritical
    Else
        MsgBox Err.Description, vbCritical, "出错 #" & Err
    End If
    Resume ExitHere

End Sub[filename]导出word.mdb[/filename][filename]通知单模板.doc[/filename]

弄好之后,发现有些文字自动转成图片了,就麻烦直接看access文件吧

[ Last edited by jjdg on 2014-2-13 at 21:16 ]
回复此楼

» 本帖附件资源列表

  • 欢迎监督和反馈:小木虫仅提供交流平台,不对该内容负责。
    本内容由用户自主发布,如果其内容涉及到知识产权问题,其责任在于用户本人,如对版权有异议,请联系邮箱:xiaomuchong@tal.com
  • 附件 1 : 导出word.mdb
  • 2014-02-13 09:55:25, 488 K
  • 附件 2 : 通知单模板.doc
  • 2014-02-13 09:55:27, 50 K

» 猜你喜欢

» 本主题相关价值贴推荐,对您同样有帮助:

已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

deephill

铁杆木虫 (职业作家)

模板不懂。
用按键精灵来做,也不好搞呀
3楼2014-02-17 23:11:07
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 4 个回答

wilstar

金虫 (正式写手)

引用回帖:
3楼: Originally posted by deephill at 2014-02-17 23:11:07
模板不懂。
用按键精灵来做,也不好搞呀

虽然没解决问题,还是谢谢了
4楼2014-02-18 09:40:22
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 材料学硕301分求调剂 +7 Liyouyumairs 2026-03-21 7/350 2026-03-21 22:31 by peike
[考研] 材料 271求调剂 +5 展信悦_ 2026-03-21 5/250 2026-03-21 17:29 by 学员8dgXkO
[考研] 26考研一志愿中国石油大学(华东)305分求调剂 +6 嘉年新程 2026-03-15 6/300 2026-03-21 17:07 by Dream007008
[考研] 求调剂 +3 白QF 2026-03-21 3/150 2026-03-21 13:12 by zhukairuo
[考研] 316求调剂 +6 梁茜雯 2026-03-19 6/300 2026-03-21 06:32 by Ecowxq666!
[考研] 二本跨考郑大材料306英一数二 +3 z1z2z3879 2026-03-17 3/150 2026-03-21 02:29 by JourneyLucky
[考研] 材料 336 求调剂 +3 An@. 2026-03-18 4/200 2026-03-21 01:39 by JourneyLucky
[考研] 一志愿华中科技大学,080502,354分求调剂 +5 守候夕阳CF 2026-03-18 5/250 2026-03-21 01:06 by JourneyLucky
[考研] 一志愿西南交大,求调剂 +5 材化逐梦人 2026-03-18 5/250 2026-03-21 00:26 by JourneyLucky
[考研] 22408 344分 求调剂 一志愿 华电计算机技术 +4 solanXXX 2026-03-20 4/200 2026-03-20 23:49 by alg094825
[考研] 308求调剂 +3 阿姐阿姐家啊 2026-03-18 3/150 2026-03-20 23:24 by JourneyLucky
[考研] 一志愿武汉理工材料工程专硕调剂 +9 Doleres 2026-03-19 9/450 2026-03-20 22:36 by JourneyLucky
[考研] 一志愿苏州大学材料求调剂,总分315(英一) +5 sbdksD 2026-03-19 5/250 2026-03-20 22:10 by luoyongfeng
[考研] 一志愿 南京航空航天大学大学 ,080500材料科学与工程学硕 +5 @taotao 2026-03-20 5/250 2026-03-20 20:16 by JourneyLucky
[考研] 086500 325 求调剂 +3 领带小熊 2026-03-19 3/150 2026-03-20 18:38 by 尽舜尧1
[考研] 材料与化工求调剂 +7 为学666 2026-03-16 7/350 2026-03-19 14:48 by 尽舜尧1
[考研] 326求调剂 +5 上岸的小葡 2026-03-15 6/300 2026-03-17 17:26 by ruiyingmiao
[考研] 333求调剂 +3 文思客 2026-03-16 7/350 2026-03-16 18:21 by 文思客
[考研] 070303 总分349求调剂 +3 LJY9966 2026-03-15 5/250 2026-03-16 14:24 by xwxstudy
[考研] 0856求调剂 +3 刘梦微 2026-03-15 3/150 2026-03-16 10:00 by houyaoxu
信息提示
请填处理意见