注册 登录
编程论坛 VB6论坛

求助:使用word 查找,替换,在win7下运行有时提示出错,要求退出VB

tobabycici 发布于 2016-07-29 15:51, 3276 次点击
Function WordReplace(FileName As String, SearchString2() As String, ReplaceString2() As String, k As Integer, _
                     Optional SaveFile As String = "", Optional MatchCase As Boolean = False) As Integer
On Error GoTo ErrorMsg '函数运行时发生遇外或错误,转向错误提示信息

Dim WordApp As New Word.Application
Dim wordDoc As New Word.Document
Dim wordArange As Word.Range
Dim wordSelection As Word.Selection
Dim ReplaceSign As Boolean
Dim i As Integer
Dim tt As Integer
Dim SearchString As String
Dim ReplaceString As String

'判断将要替换的文件是否存在
If Dir(FileName) = "" Then
'替换文件不存在
MsgBox "未找到" & FileName & "文件" '提示替换文件不存在信息
WordReplace = -2 '返回替换文件不存在的值
Exit Function '退出函数
End If

Set WordApp = CreateObject("Word.Application") '建立WORD实例
WordApp.Visible = False '屏蔽WORD实例窗体
Set wordDoc = WordApp.Documents.Open(FileName) '打开文件并赋予文件实例
Set wordSelection = WordApp.Selection '定位文件实例
Set wordArange = WordApp.ActiveDocument.Range(0, 1) '指定文件编辑位置
wordArange.Select '激活编辑位置

i = 0 '初始化替换次数值
ReplaceSign = True '初始化是否替换成功标志
For tt = 0 To k
    SearchString = SearchString2(tt)
    ReplaceString = ReplaceString2(tt)
    ReplaceSign = True
    Do While ReplaceSign
       ReplaceSign = wordArange.Find.Execute(SearchString, MatchCase, , , , , , wdFindContinue, , ReplaceString, True) '查找并替换
       '判断查找并替换是否成功,如果成功替换次数值递增1
        If ReplaceSign = True Then
           i = i + 1
        End If
    Loop
Next

WordApp.Visible = True


'如果替换成功,则提示是否保存
If i > 0 Then
'判断是否需要另存
   If Trim(SaveFile) <> "" Then
'需要另存
      If Dir(SaveFile) = "" Then
         wordDoc.SaveAs SaveFile '文件另存为……
      Else
'咨询是否替换文件,如果不替换则放弃本次操作,否则存在本次操作
        If MsgBox("是否替换" & SaveFile & "文件?", vbYesNo + vbQuestion, "替换") = vbYes Then
           wordDoc.SaveAs SaveFile '文件另存为……
        End If
      End If
   Else
     If MsgBox("是否保存对" & SaveFile & "更改?", vbYesNo + vbQuestion, "保存") = vbYes Then
        wordDoc.Save '保存在原文件中
     End If
  End If
End If

WordReplace = i '返回替换次数

wordDoc.Close '关闭文档实例
WordApp.Quit '关闭WORD实例
Set wordDoc = Nothing '清除文件实例
Set WordApp = Nothing '清除WORD实例


Exit Function


ErrorMsg:
MsgBox Err.Number & ":" & Err.Description '提示错误信息
WordReplace = -1 '返回错误信息值
wordDoc.Close '关闭文档实例
WordApp.Quit '关闭WORD实例
Set wordDoc = Nothing '清除文件实例
Set WordApp = Nothing '清除WORD实例

End Function
12 回复
#2
xiangyue05102016-07-29 16:57
初步看了一下好像没有什么问题,而且你的报错比较奇怪,没有遇到过。
请说明你报错时候运行到哪一行,报错窗口截图。
#3
tobabycici2016-07-30 10:54
回复 2楼 xiangyue0510
只有本站会员才能查看附件,请 登录


运行后,只要一调用这个函数,立即弹出这个
#4
tobabycici2016-07-30 11:18
估计是.Find.Execute出错,我试着简化成下面这样,还是会出上面那个错误,求解决方案

Dim WordApp As New Word.Application
Dim wordDoc As New Word.Document
Dim wordArange As Word.Range
Dim wordSelection As Word.Selection

Set WordApp = CreateObject("Word.Application") '建立WORD实例
WordApp.Visible = True '屏蔽WORD实例窗体
Set wordDoc = WordApp.Documents.Open(App.Path & "\Files\检查笔录.docx") '打开文件并赋予文件实例
Set wordSelection = WordApp.Selection '定位文件实例
Set wordArange = WordApp.ActiveDocument.Range(0, 1) '指定文件编辑位置
wordArange.Select '激活编辑位置

 wordArange.Find.Execute FindText:="YYYY", ReplaceWith:=Text28.Text, Replace:=wdReplaceAll
#5
xiangyue05102016-07-30 15:54
没有出现中断?估计是软件本身的问题。
你可以在Set WordApp = CreateObject("Word.Application") 这行加一个中断点,然后F8逐行运行试试
#6
tobabycici2016-07-30 17:10
是这行的问题
wordArange.Find.Execute FindText:="YYYY", ReplaceWith:=Text28.Text, Replace:=wdReplaceAll
#7
tobabycici2016-07-30 19:33
回复 5楼 xiangyue0510
我试着用立即窗口运行
.Find.Execute  也是要求关闭VB

我已重装了一次VB ,怎么破?请指教
#8
liuzhaoyzz2016-08-01 17:06
试试on error resume next,或者用这语句排查出错误原因先:
on error go to err1
err1:exit sub

你的代码,可能引用的时候早已经出错了吧
ErrorMsg:
MsgBox Err.Number & ":" & Err.Description '提示错误信息
WordReplace = -1 '返回错误信息值
wordDoc.Close '关闭文档实例
WordApp.Quit '关闭WORD实例
Set wordDoc = Nothing '清除文件实例
Set WordApp = Nothing '清除WORD实例

#9
pengzhanggui2016-08-02 21:48
事实证明,你的这段程序是可以执行的。我已验证。至于你运行不起来的原因:要么你VB装的有问题,缺少了什么,要么就是你没有引用正确的work library,自己检查一下咯
#10
pengzhanggui2016-08-02 21:49
话说回来,你这个function感觉还蛮好用的。收了哈。
#11
pengzhanggui2016-08-02 21:56
回复 9楼 pengzhanggui
只有本站会员才能查看附件,请 登录
#12
xiangyue05102016-08-03 11:22
以下是引用pengzhanggui在2016-8-2 21:56:57的发言:

你能正常运行? 那说明还是楼主的VB或者Word出问题了
#13
pengzhanggui2016-08-03 13:06
回复 12楼 xiangyue0510
是的,不過我是在win10下運行的。
1