It appears you have deleted your attachments...
FWIW, the macro you're using is to some extent based on code I've posted in the past - including on this board.
That said, the following macro should solve the problem:
Code:
Sub ConvertXMLDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName
strFolder = GetFolder: If strFolder = "" Then Exit Sub
If Dir(strFolder & "\ChangedFiles", vbDirectory) = "" Then MkDir strFolder & "\ChangedFiles"
strFile = Dir(strFolder & "\*.xml", vbNormal)
While strFile <> ""
If strFolder & "\" & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, Visible:=False, AddToRecentFiles:=False)
With wdDoc
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = False
.Execute FindText:="%ISOEntities;", ReplaceWith:="<!ENTITY % ISOEntities PUBLIC @", Replace:=wdReplaceAll
.Execute FindText:="@", ReplaceWith:="""ISO 8879-1986//ENTITIES ISO Character Entities 20030531//EN//XML""""""http://www.s1000d.org/S1000D_4-1/ent/ISOEntities"""">%ISOEntities;", Replace:=wdReplaceAll
.Execute FindText:="<!DOCTYPE pm [", ReplaceWith:="", Replace:=wdReplaceAll
.Execute FindText:="Supporting Front Matter", ReplaceWith:="", Replace:=wdReplaceAll
.Execute FindText:="<!--Arbortext, Inc., 1988-2011, v.4002-->", ReplaceWith:="", Replace:=wdReplaceAll
.Execute FindText:="<dmodule>", ReplaceWith:="<!--Arbortext, Inc., 1988-2011, v.4002--><dmodule>", Replace:=wdReplaceAll
.MatchWildcards = True
.Execute FindText:="(<pmEntryTitle>)[1-3]@>", ReplaceWith:="\1", Replace:=wdReplaceAll
.Execute FindText:="(<pmEntryTitle>).[0-9]@>", ReplaceWith:="\1", Replace:=wdReplaceAll
.MatchWildcards = False
.Execute FindText:="<pmEntryTitle> Title Page</pmEntryTitle>", ReplaceWith:="", Replace:=wdReplaceAll
.Execute FindText:="<pmEntryTitle> List of Acronyms and Abbreviations</pmEntryTitle>", ReplaceWith:="", Replace:=wdReplaceAll
.Execute FindText:="<pmEntry>", ReplaceWith:="", Replace:=wdReplaceAll
.MatchWildcards = True
.Execute FindText:="([^13^l]){2,}", ReplaceWith:="\1", Replace:=wdReplaceAll
End With
.SaveAs2 FileName:=strFolder & "\ChangedFiles\output-" & .Name, FileFormat:=.SaveFormat, AddToRecentFiles:=False
End With
End If
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function