从 .doc 文档中批量删除突出显示的 Word 宏（并将其另存为 .docx）

Question

我正在搜索批量打开 .doc 文档并将它们保存为 .docx 的宏。我已经找到了一个。现在我想删除所有文档中的任何突出显示（保留文本；以及进行更多清理操作）。当我在其中添加一行（到我能猜到的最佳位置）时，它会连续运行而不会在最后一个文档之后停止。知道在哪里以及如何修改它吗？

Sub batch_cleaner()

Dim strFilename As String
Dim strDocName As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Dim intPos As Integer
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
    .Title = "Select folder and click OK"
    .AllowMultiSelect = False
    .InitialView = msoFileDialogViewList
    If .Show <> -1 Then
        MsgBox "Cancelled By User", , "List Folder Contents"
        Exit Sub
    End If
    strPath = fDialog.SelectedItems.Item(1)
    If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
    Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
    strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFilename = Dir$(strPath & "*.doc")
While Len(strFilename) <> 0
    Set oDoc = Documents.Open(strPath & strFilename)

' 我在这里尝试添加东西

    strDocName = ActiveDocument.FullName
    intPos = InStrRev(strDocName, ".")
    strDocName = Left(strDocName, intPos - 1)
    strDocName = strDocName & ".docx"
    oDoc.SaveAs FileName:=strDocName, _
        FileFormat:=wdFormatDocumentDefault
    oDoc.Close SaveChanges:=wdDoNotSaveChanges
    strFilename = Dir$()
Wend

End Sub

而这段代码总是毁了它：

 Selection.WholeStory
 Selection.Range.HighlightColorIndex = wdNoHighlight

Answer 1

问题在于.docx 文件的“短名称”（8.3 名称）。它的名称仍以 .doc 结尾，因此它还会在 dir$() 调用中找到您的新文件。

这可以很容易地在命令提示符下演示（伪造的.doc 文件只是为了显示名称问题）：

C:\> echo x> 1.docx
C:\> if exist *.doc echo y
y
C:\> dir *.doc
09/03/2014  06:27 PM                 3 1.docx
C:\> dir /x *.doc
09/03/2014  06:27 PM                 3 100FD~1.DOC  1.docx

所以您会看到短名称，虽然从普通视图中隐藏，但实际上是一个 .DOC 文件，因此它匹配。同样在你的脚本中它会匹配。

我想到了几个选项：

• 将文件命名为其他不匹配的名称，例如 .xyz，然后稍后进行批量重命名
• 使用子目录来存储生成的文件，这样它就不会再次匹配 dir$() 调用