excelexcel-2010export-to-xmlvba

Creating Excel Macro for Exporting XML to a certain folder


I need to create a macro (which I have never done before) and if you guys can guide me to a right path, it would be really appreciated.

What I'm doing currently: I have created a mapping XML which I have imported into Excel. Once it is imported into Excel, users will then go ahead and paste some data in it and export it to receive an XML data file, which then user can drop it to a FTP where the job picks it up and imports it into database.

Here's the problem: The export has following node, which I do not want:

 <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
 <Root xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

Instead I want to replace it with following:

<?xml version="1.0" ?>
<Root xmlns="http://tempuri.org/CourseImport.xsd">

How do I automate this? Is there some kind of setting in Excel that could make it happen?

Basically, I want the export to have my root instead of the default root and I want to automatically be able to drop the file to specified path: example: \development\school\course import

Thanks!


Solution

  • My co-worker actually helped me out with this. I thought I should share what I did

    Sub ExportXML()
    '
    ' Export XML Macro exports the data that is in Excel to XML.
    '
    Const ForReading = 1
    Const ForWriting = 2
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    '
    newFileName = Application.GetSaveAsFilename("out.xml", "XML Files (*.xml), *.xmls")
    If newFileName = False Then
    Exit Sub
    End If
    If objFSO.FileExists(newFileName) Then
    objFSO.DeleteFile (newFileName)
    End If
    ActiveWorkbook.XmlMaps("Root_Map").Export URL:=newFileName
    
    
    Set objFile = objFSO.OpenTextFile(newFileName, ForReading)
    
    
    Dim count
    count = 0
    Do Until objFile.AtEndOfStream
     strLine = objFile.ReadLine
     If count = 0 Then
        strNewContents = strNewContents & "<?xml version=""1.0"" ?>" & vbCrLf
    ElseIf count = 1 Then
        strNewContents = strNewContents & "<Root xmlns=""http://tempuri.org/import.xsd"">" & vbCrLf
    Else
        strNewContents = strNewContents & strLine & vbCrLf
    End If
    count = count + 1
    
    Loop
    
    objFile.Close
    
    Set objFile = objFSO.OpenTextFile(newFileName, ForWriting)
     objFile.Write strNewContents
    
    objFile.Close
    End Sub