代码报错
代码报错
######代码无法运行
######代码无法运行
Sub 批量操作WORD()
Dim path As String
Dim FileName As String
Dim worddoc As Document
Dim MyDir As String
MyDir = "C:\Users\123456\Downloads" '文件夹路径根据需要自己修改,需要处理的文件都放该文件夹内
FileName = Dir(MyDir & ".doc", vbNormal)
Do Until FileName = ""
If FileName <> ThisDocument.Name Then
Set worddoc = Documents.Open(MyDir & "" & FileName)
worddoc.Activate
Call Word文件改名 '调用宏,换成你自己宏的名字
worddoc.Close True
FileName = Dir()
End If
Loop
Set worddoc = Nothing
End Sub
'======================下面的宏换成你自己的宏=================================
Sub Word文件改名()
Dim myS, myP As String
myP = ActiveDocument.path
Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=13
Selection.EndKey wdLine
Selection.HomeKey wdLine, wdExtend
myS = Selection.Range.Text
ActiveDocument.SaveAs FileName:=myP & "" & myS & ".doc"
End Sub
百度上搜索到的代码 ,可是不能使用
Sub 批量操作WORD()
Dim path As String
Dim FileName As String
Dim worddoc As Document
Dim MyDir As String
MyDir = "C:\Users\hp\Desktop\改名\待处理" '文件夹路径根据需要自己修改,需要处理的文件都放该文件夹内
FileName = Dir(MyDir & ".doc", vbNormal)
Do Until FileName = ""
If FileName <> ThisDocument.Name Then
Set worddoc = Documents.Open(MyDir & "" & FileName)
worddoc.Activate
Call Word完美文档 '调用宏,换成你自己宏的名字
worddoc.Close True
FileName = Dir()
End If
Loop
Set worddoc = Nothing
End Sub
Sub 完美文档()
'
' 完美文档 宏
'
'
Selection.EndKey Unit:=wdStory
Selection.EndKey Unit:=wdStory
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.InsertBreak Type:=wdSectionBreakContinuous
Selection.TypeParagraph
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveWindow.Panes(2).Activate
ActiveDocument.RemoveDocumentInformation (wdRDIDocumentProperties)
ActiveDocument.Save
End Sub
这是我仿照上面作的代码,代码一直报错,崩溃~~~