locked
XML - DOMDocuments RRS feed

  • Question

  • Good morning
    My problemis the following:
    I have a VBA code that tansform data in a table in a xml file, so far so good:

    --------------------------------------------

    Private Function CreateDOM()
        Dim dom
        Set dom = New DOMDocument60
        dom.async = False
        dom.validateOnParse = False
        dom.resolveExternals = False
        Set CreateDOM = dom
    End Function

    Private Sub ExportXMLCB_Click2()
        Dim dom As DOMDocument
        Dim node As IXMLDOMNode
        Dim headernode As IXMLDOMNode
        Dim root As IXMLDOMNode
        Dim att As IXMLDOMNode
        Set dom = CreateDOM
            ' Create a processing instruction targeted for xml.
        dom.appendChild dom.createProcessingInstruction("xml", _
            "version='1.0' encoding='UTF-8'")
            ' Create the root element and add attribute
        Set root = dom.createElement("Root")
        Set att = dom.createAttribute("xmlns")
            att.nodeValue = ("shema")
            root.Attributes.setNamedItem att
               dom.appendChild root
            'Adding 1st child of root tabela header
            Set headernode = dom.createElement("Header")
            root.appendChild headernode
               'Adding grand childs
             'EPAManufacturerCode
                Set node = dom.createElement("AuditFileVersion")
                node.appendChild dom.createTextNode("test1")
                headernode.appendChild node
                Set node = dom.createElement("CompanyID")
                node.appendChild dom.createTextNode("test2")
                headernode.appendChild node
                Set node = dom.createElement("TaxRegistrationNumber")
                node.appendChild dom.createTextNode("Teste")
                headernode.appendChild node
        ' Save the XML document to a file.
        dom.Save (Application.CurrentProject.Path & "\test12.xml")
        MsgBox ("XML export complete.")
    End Sub

    ---------------------------------------------------------------------------------

    and I get the following file:

    <?xml version="1.0" encoding="UTF-8"?> -<Root xmlns="shema">

    -<Header xmlns="">

    <AuditFileVersion>test1</AuditFileVersion>

    <CompanyID>test2</CompanyID>

    <TaxRegistrationNumber>Teste</TaxRegistrationNumber>

    </Header>

    </Root>


    But when I see the source code, all data are in une line, like that:

    <?xml version="1.0" encoding="UTF-8"?>
    <Root xmlns="shema"><Header xmlns=""><AuditFileVersion>test1</AuditFileVersion><CompanyID>test2</CompanyID><TaxRegistrationNumber>Teste</TaxRegistrationNumber></Header></Root>

    but I want everyone to be on a separate line like this:

    ?xml version="1.0" encoding="UTF-8"?>
    <Root xmlns="shema">
    <Header xmlns="">
    <AuditFileVersion>test1</AuditFileVersion>
    <CompanyID>test2</CompanyID>
    <TaxRegistrationNumber>Teste</TaxRegistrationNumber>
    </Header>
    </Root>
    
    Thank you in advance all the help available.
    • Moved by Youen Zen Thursday, March 21, 2013 7:12 AM From Visual Basic
    Wednesday, March 20, 2013 4:52 AM

Answers

  • Maybe an overkill, but you could adapt the code below:

    Sub fExample()
        Dim strFile As String
        Dim intFF As Long
        Dim strPath As String
        
        strPath = "c:\temp\test12.xml"
        intFF = FreeFile
        Open strPath For Binary As #intFF
        strFile = Space(LOF(intFF))
        Get #intFF, , strFile
        Close #intFF
    
        strFile = Replace(strFile, ">", ">" & vbCrLf)
        Do While InStr(strFile, vbCrLf & vbCrLf) > 0
            strFile = Replace(strFile, vbCrLf & vbCrLf, vbCrLf)
        Loop
        
        Kill strPath
        
        Open strPath For Binary Access Write As #intFF
        Put #intFF, , strFile
        Close #intFF
    End Sub



    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marked as answer by tekkinho Friday, March 22, 2013 1:01 AM
    Thursday, March 21, 2013 11:08 PM

All replies

  • Hello,

    Thanks for your post. This forum is for VB.Net issue. Since your post is related to VBA, I'll move this thread to a VBA forum.

    Regards,


    Shanks Zen
    MSDN Community Support | Feedback to us
    Develop and promote your apps in Windows Store
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    Thursday, March 21, 2013 7:12 AM
  • Maybe an overkill, but you could adapt the code below:

    Sub fExample()
        Dim strFile As String
        Dim intFF As Long
        Dim strPath As String
        
        strPath = "c:\temp\test12.xml"
        intFF = FreeFile
        Open strPath For Binary As #intFF
        strFile = Space(LOF(intFF))
        Get #intFF, , strFile
        Close #intFF
    
        strFile = Replace(strFile, ">", ">" & vbCrLf)
        Do While InStr(strFile, vbCrLf & vbCrLf) > 0
            strFile = Replace(strFile, vbCrLf & vbCrLf, vbCrLf)
        Loop
        
        Kill strPath
        
        Open strPath For Binary Access Write As #intFF
        Put #intFF, , strFile
        Close #intFF
    End Sub



    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marked as answer by tekkinho Friday, March 22, 2013 1:01 AM
    Thursday, March 21, 2013 11:08 PM
  • Sorry,

    thanks

    Friday, March 22, 2013 12:33 AM
  • Works flawlessly, perhaps not the ideal solution, but is very close.

    Obrigada

    Aproveitei e tirei o teu contato na tua página web, como vi que trabalhas como consultor informatico, pode ser que ainda me possas ser útil.

    Mais uma vez obrigada.

    Friday, March 22, 2013 1:01 AM