vbs批量替换word中部分文本

我有20个doc文档，现在需要修改每个文档里的名字，原文档里每个都有“张三”，现在要把这个张三换成“李四”，告诉我单个文件中怎么全部替换即可，用vbs或者bat都行。解决... 我有20个doc文档，现在需要修改每个文档里的名字，原文档里每个都有“张三”，现在要把这个张三换成“李四”，告诉我单个文件中怎么全部替换即可，用vbs或者bat都行。解决了给100分。展开

 我来答

3个回答

#热议# 为什么说不要把裤子提到肚脐眼？

a1196381
推荐于2016-03-13 · TA获得超过1.2万个赞

知道小有建树答主

回答量：2121

采纳率：0%

帮助的人：85.4万

我也去答题访问个人页

关注

展开全部

方法如下：

把一批.doc文件拖拽到这个VBS文件上，松开手，再按提示运作就行了。
不打开doc文件就能够批量替换的vbs程序
On Error Resume next
Set objWord = CreateObject("Word.Application")
If Wscript.Arguments.Count <> 0 Then
Findstr=InputBox(chr(13)&" 输入要查找的字符串 ", "输入查找字符","vbs")
If Findstr = "" Then WScript.Quit
replstr=InputBox(chr(13)&" 输入要替换的字符串 ", "输入替换字符","word vba")
For i=0 To WScript.Arguments.Count-1
filepath=WScript.Arguments(i)
kkk(filepath)
Next
objWord.Documents.close
else
WScript.Quit
End If

sub kkk(abcpath)
objWord.Visible = True
Set objDoc = objWord.Documents.Open(abcpath)
Set objSelection = objWord.Selection
objSelection.HomeKey 6
With objSelection.Find
.Text = Findstr
.Replacement.Text = replstr
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute ,,,,,,,,,,2
End With
objWord.Documents.Save
end sub

已赞过 已踩过<

评论收起

博思aippt
2024-07-20 广告

作为深圳市博思云创科技有限公司的工作人员，对于Word文档生成PPT的操作，我们有以下建议：1. 使用另存为功能：在Word中编辑完文档后，点击文件->另存为，选择PowerPoint演示文稿（*.pptx）格式，即可将文档内容转换为PPT... 点击进入详情页

本回答由博思aippt提供

daode1212
推荐于2016-01-14 · 超过53用户采纳过TA的回答

知道小有建树答主

回答量：176

采纳率：0%

帮助的人：143万

我也去答题访问个人页

关注

展开全部

''''''''''''''''''''''''''''''''''''''''''''''''''''
'''递归遍历DOC文档,替换单词后生成新DOC文件(原文件名前加上:new_)
'''请把本VBS文件放入有DOC文档的目录中运行
'''关键点:打开DOC文档读取内容,创建DOC文档写入内容
'''处理结果报告文件:index.html
'''设计:daode1212,QQ:1501488900,2014-03-26
''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim c '''count files
indexFile = "index.html" '生成文件目录列表
Set WshShell = CreateObject("WSCRIPT.SHELL")
Set FSO = CreateObject("Scripting.FileSystemObject")
'Get the current directory :
'WScript.Echo WshShell.CurrentDirectory
way = WshShell.CurrentDirectory & "\"
Set lst = FSO.OpenTextFile(way & indexFile, 8, 1)
hdstr = "<body bgcolor='#ddeeff'><center><h2>递归遍历DOC文档,替换单词后生成新DOC文件</h2><table border='1' align='center' bgcolor='#f0f0f0'>"
hdstr = hdstr & "<th>文件列表</th><th>文件路径与新文件名</th>"
  ''''''''''''''''''''''''''''''''''
  EveryFile way    ''' 调用遍历与替换主过程
  ''''''''''''''''''''''''''''''''''
hdstr = hdstr & "</table>"
MsgBox c & " 个文件处理(目录: " & way & ") 已经完成 . ---------by daode1212 2014-03-26"
lst.Write hdstr
Set FSO = Nothing
WshShell.run "iexplore.exe " & way & indexFile
'''##################################################
'遍历文件夹与文件:
Function EveryFile(way)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set f = FSO.GetFolder(way)
    Set fc = f.SubFolders
    Set fs = f.Files
    '遍历子文件夹
    For Each fd In fc
       EveryFile (fd & "\")
    Next
    '遍历所有文件:
    For Each Fi In fs
      ef = Fi.Name
      If InStr(ef, ".doc") > 0 Then ReplacText way, ef
    Next
    
    Set FSO = Nothing
End Function
'''##################################################
'内容替换:
Sub ReplacText(way, fname)
'for read word document =============================================:
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fi = FSO.OpenTextFile(way & fname, 1)
Ftxt = LCase(Fi.ReadAll)
Set wdObj = CreateObject("Word.Application")
Set wd = wdObj.Documents.Open(way & fname)
    '''wd.Activate
    allstr = wd.Content
    '''从下行中修改自己想要的替换:
    If InStr(allstr, "张三") = 0 Then
         wd.Close
         wdObj.Quit
         Exit Sub
    Else
       allstr = Replace(allstr, "张三", "李四")
    End If
    wd.Close
    wdObj.Quit
Set wd = Nothing
Set wdObj = Nothing
'for write  word document =============================================:
Set Doc = CreateObject("Word.Application")
Set DocWord = Doc.Documents.Add()
    Doc.Selection.TypeText allstr
    '''修改下行以生成不同的新文件:
    DocWord.saveas way & "new_" & fname
    DocWord.Close
    Doc.Quit
Set DocWord = Nothing
Set Doc = Nothing

'for table log =========================================:
  c = c + 1
  hdstr = hdstr & "<tr><td>" & c & "</td><td>:" & way & " new_" & fname & "</td></tr>"
End Sub
'''##################################################
'''==================================================
如针对word页眉页脚,参考一下以下代码:
怎样用VBA读取word页眉页脚？

'Sub Example() 

'Dim myRange As Range

首页页眉   ' Set myRange = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range 
'Debug.Print myRange.Text
偶数页页眉   ' Set myRange = ActiveDocument.Sections(1).Headers(wdHeaderFooterEvenPages).Range 
'Debug.Print myRange.Text
基本页眉   ' Set myRange = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range 
 '   Debug.Print myRange.Text 
'End Sub
其中，如果节中只使用一种页眉（基本页眉时），请使用以下代码返回
'Set myRange = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range 
'Debug.Print myRange.Text 

#vba


本回答被提问者采纳






已赞过已踩过<

你对这个回答的评价是？
评论收起

铁人wjx
2014-03-14 · TA获得超过9755个赞

知道大有可为答主

回答量：4139

采纳率：56%

帮助的人：2065万

我也去答题访问个人页

关注

展开全部

自己录制一个宏：点开工具→宏→录制宏→开始录制→查找→张三→替换为→李四→全部替换→停止录制。
点开其他的文档，直接运行该宏即可。
试试？

追问

页眉页脚的替换不掉

已赞过 已踩过<

评论收起

更多回答（1）

推荐律师服务：若未解决您的问题，请您详细描述您的问题，通过百度律临进行免费专业咨询

vbs批量替换word中部分文本

其他类似问题

为你推荐：