CODEWITHSUNDEEP
excelxmlvba
user8107531
user8107531

Reputation: 27

XML multiline to single line using VBA

I have an excel file. One of the cells include an XML script. I need to fetch the contents of this cell and paste them in a notepad. I am done with everything except I am unable to have the entire XML script in one single line. No white spaces after and before tags and no new line characters. Please assist. To maintain client data privacy, I have pasted below a sample XML script. This script is supposed to be in B7 cell of excel.

I cannot replace white spaces with nothing since I don't want the white spaces between attributes to be replaced with nothing.

P.S. I also tried using the Trim function, but that didn't work. 

Range("B7").Value = Trim(Range("B7").Value)

XML Script -

<Tag1>
    <Tag2 xml version="1.0"/>
    <Tag3>
        <Tag4 name="Tag4">Hello</Tag4>
    </Tag3>
</Tag1>

Upvotes: 0

Views: 411

Answers (3)

YasserKhalil
YasserKhalil

Reputation: 9568

Try replacing Chr(10) with nothing

Sub Test()
Dim sInput As String
sInput = Range("A1").Value
sInput = Application.WorksheetFunction.Trim(Replace(sInput, Chr(10), ""))
Debug.Print sInput
End Sub

Another approach to get rid of white spaces

Sub Test2()
Dim x, sOut As String, i As Long
x = Split(Range("A1").Value, Chr(10))
For i = LBound(x) To UBound(x)
    sOut = sOut & Application.WorksheetFunction.Trim(x(i))
Next i
Debug.Print sOut
End Sub

Another approach using Regex

Sub Test_Using_Regex()
Dim sInput As String
sInput = Join(Split(Range("A1").Value, Chr(10)), "")
With CreateObject("VBScript.RegExp")
    .Pattern = ">(\s*)<"
    If .Test(sInput) Then Debug.Print Replace(Trim(sInput), .Execute(sInput)(0).SubMatches(0), "") '.Replace(sInput, "$1")
End With
End Sub

Upvotes: 0

FaneDuru
FaneDuru

Reputation: 42236

Try this function, please:

Function UniqueXMLStr(strXML) As String
  Dim arrXML As Variant, strUnique As String

   arrXML = Split(strXML, vbLf)
   strUnique = Join(arrXML, "")
   UniqueXMLStr = Replace(strUnique, "    ", "")
End Function

It can be tested using the next test Sub:

Sub testUnique()
    Dim cel As Range
    Set cel = ActiveCell 'here you will have your example XML string
    Debug.Print UniqueXMLStr(cel.value) 'Here the unique string will be shown in Immediate Window (Ctrl + G in Visual Basic Editor)...
End Sub

Upvotes: 1

Scott Craner
Scott Craner

Reputation: 152585

Function manyToOne(str As String)
    Do Until InStr(str, Chr(10) & " ") = 0
        str = Replace(str, Chr(10) & " ", Chr(10))
    Loop
    str = Replace(str, Chr(10), "")
    manyToOne = str
End Function

then you can call it from the sheet:

=manyToOne(A1)

enter image description here

Upvotes: 3

Related Questions