VB操作word总结

请耐心看完：问题出现得较复杂。

我的目的：
将多个文档内容逐一拷贝粘贴到另一文档后面
我的方法：
wordapp=new word.application
Set doc = wordapp.Documents.Add
while
pathTemp = App.Path & "\temp.doc"
LoadFile rs("word"), pathTemp
Set doctemp = wordapp.Documents.Open(pathTemp)
doctemp.Content.Select
wordapp.Selection.copy
Set myRange = doc.Range(Start:=doc.Content.End - 1, En d:=doc.Content.End)
myRange.Select
' wordapp.Selection.delete
wordapp.Selection.InsertParagraphBefore
wordapp.Selection.Collapse wdCollapseEnd
wordapp.Selection.paste
Clipboard.Clear
doctemp.Close wdDoNotSaveChanges
doc.SaveAs App.Path & "\papertemp.doc"
如果我的文档（待拷贝的文档，这些文档都是从数据库中读出来的，存在pathTemp文件中）都较小的话，我的程序可以顺利完成任务，如果其中一个文档较大，那么问题出现了，但是问题不是马上出现，该文档的内容能顺利从数据库下载到文件pathTemp中，也能打开到doctemp中，复制粘贴到doc中也没有问题，但是关闭doctemp时却发现隐藏的~$temp.doc并没有消失（意味着doctemp并没有关闭？），接着我把下一个文档从数据库读出放到doctemp中也能完成，temp.doc中内容正确，但是当我用
Set doctemp = wordapp.Documents.Open(pathTemp)打开时却出现了问题，
运行时错误‘5121’
文档的名称或路径无效，请使用如下建议：....
手动打开temp.doc也出现同样的错误，但是当我关掉doc(即papertemp.doc)时，打开temp.doc却是正常，而且里面数据也正常
请高手指教，愿送所有分问题点数：100、回复次数：8Top
1 楼faysky2（出来混，迟早是要还嘀）回复于2005-10-26 01:19:45 得分4
是着释放doctemp 看看：
....
Clipboard.Clear
doctemp.Close wdDoNotSaveChanges
doc.SaveAs App.Path & "\papertemp.doc"
Set doctemp=Nothing'--->释放掉doctemp
Top
2 楼hapluo（言先必行，多说无益）回复于2005-10-26 20:49:54 得分0
还是不行，
哪位高手帮我解决，另送200分Top
3 楼hapluo（言先必行，多说无益）回复于2005-10-26 20:56:53 得分0
这个号所有分相送，这个号就剩500分了，数来帮我啊，
分不够我另外一个号还可再加！Top
4 楼hapluo（言先必行，多说无益）回复于2005-10-26 21:28:5
5 得分0
help,Top
5 楼mylord（）回复于2005-10-2
6 21:55:46 得分2
正在学习中...Top
6 楼northwolves（狼行天下）回复于2005-10-26 23:46:20 得分90
何必打开,直接合并不行? 试试:
Private Sub Command1_Click()
Dim wordapp As New Word.application, doc As New Document, pathtemp As String
Set doc = wordapp.Documents.Open(App.Path & "\papertemp.doc")
doc.Content.Select
Do While Not rs.EOF
pathtemp = App.Path & "\temp.doc"
LoadFile rs("word"), pathtemp'你写的过程吧
With wordapp.selection
.InsertFile FileName:=pathtemp, ConfirmConversions:=False
.InsertParagraphAfter
.InsertBreak Type:=wdSectionBreakNextPage
.Collapse Direction:=wdCollapseEnd
End With
Kill pathtemp
rs.movenext
Loop
doc.Save
End If
Top
7 楼faysky2（出来混，迟早是要还嘀）回复于2005-10-26 23:48:40 得分4
把doc也关掉试试：
.....
Clipboard.Clear
doctemp.Close wdDoNotSaveChanges
doc.SaveAs App.Path & "\papertemp.doc"
doctemp.Quit
doc.Quit
Set doc=Nothing Top
8 楼hapluo（言先必行，多说无益）回复于2005-10-27 00:57:23 得分0
northwolves(狼行天下) ，非常感谢，虽然没有问题之所在，但是绕开了问题相当于解决了问题，再次感谢！
有什么办法可以把分一下相送，以示感激之情？除了多开几贴还有其他办法嘛？
vb控制word的类模块,查找、替换Word文档内容
在ＶＢ6.0中，操作word，使用它强大的查找、替换、删除、复制、翦切功能。

还可以把特定字符替换成图片。

有了它你就可以使用数据库中的内容或图片文件替换word文件中的特定字符。

只要把下列内容复制到写字板中，另存为SetWord.cls文件，然后在把它添加到工程中，就可以使用了。

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "SetWord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private mywdapp As Word.Application
Private mysel As Object
'属性值的模块变量
Private C_TemplateDoc As String
Private C_newDoc As String
Private C_PicFile As String
Private C_ErrMsg As Integer
Public Event HaveError()
Attribute HaveError.VB_Description = "出错时激发此事件.出错代码为ErrMsg属性"
'***************************************************************
'ErrMsg代码：1－word没有安装2-缺少参数3-没权限写文件
' 4-文件不存在
'
'***************************************************************
Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As Integer Attribute ReplacePic.VB_Description = "查找FindStr,并替换为PicFile所指向的图片文件,替换次数由time参数确定,为0时，替换所有"
'********************************************************************************
'从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像
' 替换次数由time参数确定，为0时，替换所有
'******************************************************************************** If Len(C_PicFile) = 0 Then
C_ErrMsg = 2
Exit Function
End If
Dim i As Integer
Dim findtxt As Boolean
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=True)
If Not findtxt Then
ReplacePic = 0
Exit Function
End If
i = 1
Do While findtxt
mysel.InlineShapes.AddPicture FileName:=C_PicFile
If i = Time Then Exit Do
i = i + 1
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=True)
Loop
ReplacePic = i
End Function
Public Function FindThis(FindStr As String) As Boolean
Attribute FindThis.VB_Description = "查找FindStr,如果模板中有FindStr则返回True" If Len(FindStr) = 0 Then
C_ErrMsg = 2
Exit Function
End If
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
mysel.HomeKey Unit:=wdStory
FindThis = mysel.Find.Execute
End Function
Public Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0) As Integer
Attribute ReplaceChar.VB_Description = "查找FindStr,并替换为RepStr,替换次数由time 参数确定,为0时，替换所有"
'********************************************************************************
'从Word.Range对象mysel中查找FindStr，并替换为RepStr
' 替换次数由time参数确定，为0时，替换所有
'********************************************************************************
Dim findtxt As Boolean
If Len(FindStr) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Function
End If
mysel.Find.ClearFormatting
mysel.Find.Replacement.ClearFormatting
With mysel.Find
.Text = FindStr
.Replacement.Text = RepStr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
If Time > 0 Then
For i = 1 To Time
mysel.HomeKey Unit:=wdStory
findtxt = mysel.Find.Execute(Replace:=wdReplaceOne) If Not findtxt Then Exit For
Next
If i = 1 And Not findtxt Then
ReplaceChar = 0
Else
ReplaceChar = i
End If
Else
mysel.Find.Execute Replace:=wdReplaceAll
End If
End Function
Public Function GetPic(PicData() As Byte, FileName As String) As Boolean Attribute GetPic.VB_Description = "把图像数据PicData,存为PicFile指定的文件" '********************************************************************************
'把图像数据PicData,存为PicFile指定的文件
'********************************************************************************
On Error Resume Next
If Len(FileName) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Function
End If
Open FileName For Binary As #1
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Function
End If
'二进制文件用Get,Put存放，读取数据
Put #1, , PicData
Close #1
C_PicFile = FileName
GetPic = True
End Function
Public Sub DeleteToEnd()
Attribute DeleteToEnd.VB_Description = "删除从当前位置到结尾的所有内容" mysel.EndKey Unit:=wdStory, Extend:=wdExtend
mysel.Delete Unit:=wdCharacter, Count:=1
End Sub
Public Sub MoveEnd()
Attribute MoveEnd.VB_Description = "光标移动到文档结尾"
'光标移动到文档结尾
mysel.EndKey Unit:=wdStory
End Sub
Public Sub GotoLine(LineTime As Integer)
mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:="" End Sub
Public Sub OpenDoc(view As Boolean)
Attribute OpenDoc.VB_Description = "打开Word文件,View确定是否显示Word界面" On Error Resume Next
'********************************************************************************
'打开Word文件，并给全局变量mysel赋值
'********************************************************************************
If Len(C_TemplateDoc) = 0 Then
mywdapp.Documents.Add
Else
mywdapp.Documents.Open (C_TemplateDoc)
End If
If Err.Number <> 0 Then
C_ErrMsg = 4
RaiseEvent HaveError
Exit Sub
End If
mywdapp.Visible = view
mywdapp.Activate
Set mysel = mywdapp.Application.Selection
'mysel.Select
End Sub
Public Sub OpenWord()
On Error Resume Next
'******************************************************************************** '打开Word程序，并给全局变量mywdapp赋值
'******************************************************************************** Set mywdapp = CreateObject("word.application")
If Err.Number <> 0 Then
C_ErrMsg = 1
RaiseEvent HaveError
Exit Sub
End If
End Sub
Public Sub ViewDoc()
Attribute ViewDoc.VB_Description = "显示Word程序界面" mywdapp.Visible = True
End Sub
Public Sub AddNewPage()
Attribute AddNewPage.VB_Description = "插入分页符"
mysel.InsertBreak Type:=wdPageBreak
End Sub
Public Sub WordCut()
Attribute WordCut.VB_Description = "剪切模板所有内容到剪切板"
'保存模板页面内容
mysel.WholeStory
mysel.Cut
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordCopy()
Attribute WordCopy.VB_Description = "拷贝模板所有内容到剪切板"
mysel.WholeStory
mysel.Copy
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordDel()
mysel.WholeStory
mysel.Delete
mysel.HomeKey Unit:=wdStory
End Sub
Public Sub WordPaste()
Attribute WordPaste.VB_Description = "拷贝剪切板内容到当前位置"
'插入模块内容
mysel.Paste
End Sub
Public Sub CloseDoc()
Attribute CloseDoc.VB_Description = "关闭Word文件模板"
'******************************************************************************** '关闭Word文件模本
'******************************************************************************** On Error Resume Next
mywdapp.ActiveDocument.Close False
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Sub
End If
End Sub
Public Sub QuitWord()
'******************************************************************************** '关闭Word程序
'******************************************************************************** On Error Resume Next
mywdapp.Quit
If Err.Number <> 0 Then
C_ErrMsg = 3
Exit Sub
End If
End Sub
Public Sub SavetoDoc()
Attribute SavetoDoc.VB_Description = "保存当前文档为FileName指定文件" On Error Resume Next
'并另存为文件FileName
If Len(C_newDoc) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Sub
End If
mywdapp.ActiveDocument.SaveAs (C_newDoc)
If Err.Number <> 0 Then
C_ErrMsg = 3
RaiseEvent HaveError
Exit Sub
End If
End Sub
Public Property Get TemplateDoc() As String
Attribute TemplateDoc.VB_Description = "模板文件名."
TemplateDoc = C_TemplateDoc
End Property
Public Property Let TemplateDoc(ByVal vNewValue As String)
C_TemplateDoc = vNewValue
End Property
Public Property Get newdoc() As String
Attribute newdoc.VB_Description = "执行CloseDoc方法时，将模板文件另存为此文件名指定的新文件.如果不指定，在执行CloseDoc方法时，将产生一个错误"
newdoc = C_newDoc
End Property
Public Property Let newdoc(ByVal vNewValue As String)
C_newDoc = vNewValue
End Property
Public Property Get PicFile() As String
Attribute PicFile.VB_Description = "图像文件名"
PicFile = C_PicFile
End Property
Public Property Let PicFile(ByVal vNewValue As String)
C_PicFile = vNewValue
End Property
Public Property Get ErrMsg() As Integer
Attribute ErrMsg.VB_Description = "错误信息.ErrMsg代码: 1-word没有安装2-缺少参数3-没权限写文件4-文件不存在"
ErrMsg = C_ErrMsg
End Property
请问如何正确杀掉word进程？
楼主btl19792008（btl19792008）2005-11-04 17:05:03 在VB / 数据库(包含打印，安装，报表) 提问
我的word程序运行几次，在资源管理器中就会出现很多word进程。

我的代码写的不对吗？
代码如下：
Dim appTemplate As Word.Application
Dim docTemplate As Word.Document
Set appTemplate = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set appTemplate = New Word.Application
End If
Set docTemplate = Nothing
Set appTemplate = Nothing
问题点数：100、回复次数：9Top
1 楼bbhere（俺是二等小兵(baby,i'll be right here waiting for you)）回复于2005-11-04 17:31:33 得分0
mark Top
2 楼province_（雍昊）回复于2005-11-04 18:03:37 得分0
要先QUIT再NOTHING。

Top
3 楼faysky2（出来混，迟早是要还嘀）回复于2005-11-0
4 19:21:30 得分0
'引用Microsoft Word X.0 Object Library
Private Sub Command1_Click()
On Error GoTo connecterr
Dim wordApp As Object
Set wordApp = CreateObject("word.application")
wordApp.Visible = True
Dim myDoc As Object
Set myDoc = wordApp.Documents.Open("c:\Test.dot")
wordApp.selection.TypeText (" Hello")
myDoc.Close '关闭
wordApp.Quit '退出
Set myDoc = Nothing
Set wordApp = Nothing
Exit Sub
connecterr:
End Sub
Top
4 楼faysky2（出来混，迟早是要还嘀）回复于2005-11-04 19:24:16 得分0
Dim appTemplate As Word.Application
Dim docTemplate As Word.Document
Set appTemplate = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set appTemplate = New Word.Application
End If
'**************
docTemplate.Close
appTemplate.Quit
'**************
Set docTemplate = Nothing
Set appTemplate = Nothing Top
5 楼rainstormmaster（暴风雨v2.0）回复于2005-11-0
6 11:01:2
7 得分0
没有office没法测试，不过我想你可以参考一下这个：
/mvm/archive/2004/04/25/20208.aspx Top
6 楼ahlegend（爱之传奇）回复于2005-11-06 20:51:45 得分0
Quit Top
7 楼szjhxu（天野）回复于2005-11-06 22:01:48 得分0
Dim appTemplate As Word.Application
Dim docTemplate As Word.Document
Set appTemplate = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set appTemplate = New Word.Application
End If
appTemplate.quit
Set docTemplate = Nothing
Set appTemplate = Nothing Top
8 楼zhf_btj（闹闹）回复于2005-11-15 21:54:47 得分0
引用四楼faysky2()
myDoc.Close '关闭
wordApp.Quit '退出
Set myDoc = Nothing
Set wordApp = Nothing
这样应该能退干净了...我的就是..光用Close和Quit.没用Nothing就老有多余的进程偶尔试下加个Nothing就OK了~~~~Top
9 楼lfh103856111（）回复于2005-11-16 12:46:09 得分0
對,注意quit就行了。