在打开的文件中添加书签并将其另存为 dcox

Question

我有一个关于书签的问题。我制作了一个宏，可以删除Word文档中的所有书签并添加一个新书签：

Sub AddBookmarkInCurrentFile()
'
' Deletes all the bookmarks in an already opened file
' and add one new bookmark in the file
'
' Deletes al current bookmarks
For Each bkm In ActiveDocument.Bookmarks
bkm.Delete
Next bkm
' Put Cursor add the beginning of the file and adds the bookmark
Selection.HomeKey Unit:=wdStory
ActiveDocument.Bookmarks.Add Name:="testBookmarkAdd"
MsgBox "Finished"
End Sub

当我运行它时，它工作正常。

因为我必须对 100 多个文档执行此操作，并将 *.doc 保存为.docx我制作了新版本的宏。一切正常接受添加新书签。下面的代码有什么问题？

Sub AddBookmarkInAllOpenedFiles()
' Opens all word files in a directory and deletes current bookmarks
' and adds one bookmark and saves the file to a docx file
Dim sSourcePath As String
Dim sTargetPath As String
Dim sDocName As String
Dim docCurDoc As Document
Dim sNewDocName As String
Dim sOrigName As String
Dim intPos As Integer
' Looking in this path
sSourcePath = "H:Mijn Documententest"
sTargetPath = "H:Mijn DocumententestConverted"
' Look for first DOC file
sDocName = Dir(sSourcePath & "*.doc")
Do While sDocName <> ""
' Repeat as long as there are source files
'Only work on files where right-most characters are ".doc"
If Right(sDocName, 4) = ".doc" Then
' Open file
Set docCurDoc = Documents.Open(FileName:=sSourcePath & sDocName)

' Deletes all the bookmarks
For Each bkm In ActiveDocument.Bookmarks
bkm.Delete
Next bkm
' Put Cursor add the beginning of the file and adds the bookmark
Selection.HomeKey Unit:=wdStory
ActiveDocument.Bookmarks.Add Name:="testBookmarkAdd"
'Saves the document as a docx
sNewDocName = Replace(sDocName, ".doc", ".docx")
With docCurDoc
.SaveAs FileName:=sTargetPath & sNewDocName, _
FileFormat:=wdFormatDocumentDefault
.Close SaveChanges:=wdDoNotSaveChanges
End With
End If
' Get next source file name
sDocName = Dir
Loop
MsgBox "Finished"
End Sub

Answer 1

尝试：

Sub BookmarkAllFilesInFolder()
' Opens all word files in a directory and deletes current bookmarks
' and adds one bookmark and saves the file to a docx file
Dim sSourcePath As String, sTargetPath As String
Dim sDocName As String, docCurDoc As Document
' Looking in this path
sSourcePath = "H:Mijn Documententest"
sTargetPath = sSourcePath & "Converted"
' Look for first DOC file
sDocName = Dir(sSourcePath & "*.doc")
' Repeat as long as there are source files
Do While sDocName <> ""
' Only open .doc files"
If Right(sDocName, 4) = ".doc" Then
' Open file
Set docCurDoc = Documents.Open(FileName:=sSourcePath & sDocName, AddToRecentFiles:=False, Visible:=False)
With docCurDoc
'Delete all existing bookmarks
While .Bookmarks.Count > 0
.Bookmarks(1).Delete
Wend
'Add our bookmark
.Bookmarks.Add Name:="TestBookmark", Range:=.Range(0, 0)
'Save the file in .docx format to the output folder
.SaveAs2 FileName:=sTargetPath & sDocName & "x", _
FileFormat:=wdFormatDocumentDefault, AddToRecentFiles:=False
.Close SaveChanges:=wdDoNotSaveChanges
End With
End If
' Get next source file name
sDocName = Dir
Loop
Set docCurDoc = Nothing
MsgBox "Finished"
End Sub