Creating Excel Macro for Exporting XML to a certain folder

NonProgrammer picture NonProgrammer · Feb 28, 2013 · Viewed 8.1k times · Source

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!

Answer

NonProgrammer picture NonProgrammer · Mar 1, 2013

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