ACCESS数据写入Word问题

初学者　发表于：2015-07-20 09:40:41 　

数据表A的字段有‘事项类型’、‘事项特点’和‘具体事例’等。现我对表A建立了按'事项类型’、‘事项特点’和记录条数的分类统计查询，查询记录有N条。我希望实现：根据查询记录中的'事项类型'和‘事项特点’，针对查询记录的每条记录筛选出表A在对应的‘具体事例’，并写入新建的Word文档中。望老师指点，谢谢！！！

Word文档的写入格式为：事项类型（写入字段的值）

事项特点（写入字段的值）记录数量（查询表的统计数）

具体事例：

1.......

2.......

3.......

Top

缪炜发表于：2015-07-20 11:12:45

【access源码示例】导入导出系列——Word数据导入导出http://www.accessoft.com/article-show.asp?id=5191

Top

煮江品茶发表于：2015-07-20 11:19:15

sub WriteWord(byval folderpath as string,byval tbname as string)
'功能：写入Word
'参数：folderpath -- Word文件所保存的文件夹地址
' tbname -- 数据表或查询的名称
'示例：Call WriteWord("C:\","事项查询")

Dim wApp As New Word.Application
Dim doc As Word.Document
Dim rs As New ADODB.Recordset
Dim ssql As String
Dim i as long,j as long

Set doc = wApp.Documents.Add
ssql="select * from " & tbname
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs.RecordCount
for j=0 to rs.fields.count-1
doc.Application.Selection.TypeText Text:=rs.fields(j).name & "：" & rs.fields(j).value
doc.Application.Selection.TypeParagraph
next
doc.Application.Selection.TypeParagraph
rs.movenext
Next

doc.SaveAs folderpath & "\" & tbname & ".doc"
wApp.Quit True

rs.close:set rs=nothing
set wApp=nothing
set doc=nothing
end sub

Top

初学者发表于：2015-07-20 15:08:23

谢谢煮江品茶老师。拜读了老师的代码，感觉老师是将"tbname"查询的所有字段的记录内容逐条写入Word文档，而不是我希望的用“tbname”查询的每条记录的相关字段筛选出表A中对应的‘具体事例’记录，并在写入一条“tbname”相关字段内容后，将从表A中筛选出对应的‘具体事例’记录一并写入新建的Word文档中，完成一个循环。在逐条写入"tbname"第二条记录以及表A中对应的'具体事例'....

不知我理解是否正确？如是望老师能帮忙完善，再次谢谢了。

Top

煮江品茶发表于：2015-07-20 15:11:42

鬼打架，看懂了，为什么不自己尝试修改呢？能修改了，不是也就学会了嘛。

修改的过程不过是以下几个方面：
1、将创建和保存Word放入循环中，以解决一条记录一个word文件问题。
2、将word文件名唯一性命名，比如记录的ID用或者循环变量等。
3、如果明确知道要写入的字段，无非是取消第二层循环，直接列出要写入的字段名称和字段值。

Top

初学者发表于：2015-07-20 21:25:51

按煮江品茶老师的建议，我试着修改了一下 , 但无法通过，黑体部分提示出错。望老师指教，谢谢！！

Dim wApp As New Word.Application

Dim doc As Word.Document
Dim rs As New ADODB.Recordset
Dim rsa As New ADODB.Recordset
Dim ssql As String
Dim ssql1 As String
Dim i As Long, j As Long

Set doc = wApp.Documents.Add
ssql = "select * from 按类型查询 "
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs.RecordCount
doc.Application.Selection.TypeText Text:=rs.类别.Value
doc.Application.Selection.TypeParagraph
doc.Application.Selection.TypeText Text:=[rs.定性].Value &' "& [rs.记录数].Value & "' & ",总额：'" & [rs.总额].Value & "' & "。"
doc.Application.Selection.TypeParagraph
doc.Application.Selection.TypeText Text:="具体事例："
doc.Application.Selection.TypeParagraph

ssql1 = "select * from 临时表库2 "
ssql1 = ssql1 + "where 类型 =" & ' "& [rs.类型].Value & "'
rsa.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For j = 1 To rsa.RecordCount
doc.Application.Selection.TypeText Text:=[rsa.具体事例].Value & "；"
doc.Application.Selection.TypeParagraph
doc.Application.Selection.TypeText Text:=[rsa.意见].Value & "；"
doc.Application.Selection.TypeParagraph
rsa.MoveNext
Next
doc.Application.Selection.TypeParagraph
rs.MoveNext
Next

'doc.SaveAs folderpath & "\" & tbname & ".doc"
doc.SaveAs "d:\sjgl\汇总.doc"
wApp.Quit True

rs.Close: Set rs = Nothing
Set wApp = Nothing
Set doc = Nothing
End Sub

Top

初学者发表于：2015-07-20 23:17:36

提示“方法和数据成员未找到”，如何解决？？？？

Top

初学者发表于：2015-07-21 10:42:53

煮江品茶老师:

我又修改了一下，但还是无法通过，在黑体字处提示” 运行时错误 ' 3705 ' 对象打开时，不允许操作“，望老师能抽空指点，确有急用，再次谢谢了......

Private Sub Command13_Click()

Dim wApp As New Word.Application
Dim doc As Word.Document
Dim rs As New ADODB.Recordset
Dim rsa As New ADODB.Recordset
Dim ssql As String
Dim ssql1 As String
Dim wtlb As String
Dim wtdx As String
Dim i As Long
Dim j As Long

Set doc = wApp.Documents.Add
ssql = "select * from 类型统计查询 "
rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs.RecordCount
doc.Application.Selection.TypeText Text:=rs.Fields(0).Value & "："
doc.Application.Selection.TypeParagraph
doc.Application.Selection.TypeText Text:=rs.Fields(1).Value & "，" & rs.Fields(2).Value & "问题" & "" & rs.Fields(3).Value & "" & "条，总涉及金额：" & "" & rs.Fields(4).Value & "" & "万元。"
doc.Application.Selection.TypeParagraph
doc.Application.Selection.TypeText Text:="具体事例："
doc.Application.Selection.TypeParagraph

wtlb = rs.Fields(0).Value
wtdx = rs.Fields(2).Value

ssql1 = "select * from A "
ssql1 = ssql1 & "where (类别 = " & " '" & wtlb & "' " & " and 定性 = " & "'" & wtdx & "'" & ")"
rsa.Open ssql1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  For j = 1 To rsa.RecordCount
doc.Application.Selection.TypeText Text:=rsa.Fields(9).Value & "；"
doc.Application.Selection.TypeParagraph
doc.Application.Selection.TypeText Text:=rsa.Fields(11).Value & "；"
  doc.Application.Selection.TypeParagraph
rsa.MoveNext
Next
doc.Application.Selection.TypeParagraph
rs.MoveNext

'doc.SaveAs folderpath & "\" & tbname & ".doc"
doc.SaveAs "C:\Users\admin\汇总报告.doc"
wApp.Quit True

rs.Close: Set rs = Nothing
Set wApp = Nothing
Set doc = Nothing
End Sub

Top

总记录：7篇页次：1/1 9 1 :

Access交流中心

ACCESS数据写入Word问题