Removing and replacing XML file words returning blank spaces/linebreaks

Rolo18 · #1 01-12-2021, 03:20 PM

Hi,

I currently have a script for a Macro that changes or deletes multiple XML files words or sentences.
Although when I run this Macro whenever it deletes a certain word or sentence it is leaving blank lines/paragraphs.
For example:
<content>

<pmEntryTitle>EHII IETM</pmEntryTitle>

<pmEntryTitle> General Front Matter</pmEntryTitle>

<pmEntryTitle> Title Page</pmEntryTitle>

Does anyone have a solution or work around that I can add to my current script so when I run the macro all together it fixes it like this:
<content>
<pmEntryTitle>EHII IETM</pmEntryTitle>
<pmEntryTitle> General Front Matter</pmEntryTitle>
<pmEntryTitle> Title Page</pmEntryTitle>

Thanks for any help.

macropod · #2 01-12-2021, 03:38 PM

Without seeing the macro concerned, plus a document containing some representative content, it's impossible to diagnose anything.

You can attach a document to a post (delete anything sensitive) via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

Rolo18 · #3 01-12-2021, 03:42 PM

Got it.

I added the XML as text file since it wasn't letting me add the XML file as it was.

macropod · #4 01-12-2021, 04:25 PM

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Replacing/Removing XML file lines	Rolo18	Word VBA	2	07-01-2020 05:07 PM
How to remove blank spaces from word file	noname	Word	5	11-02-2019 10:49 PM
Removing indentations at beginning of paragraphs and replacing with line spaces	captainamerica	Word	2	10-27-2017 05:32 PM
removing spaces in cell	Tonykiwi	Excel	4	11-06-2016 09:30 PM
Invalid Pattern Match Value for Replacing Spaces	sleake	Word	2	04-26-2013 11:26 AM