创建Excel宏以将XML导出到某个文件夹

时间:2013-02-28 18:06:11

标签: excel excel-vba excel-2010 export-to-xml vba

我需要创建一个宏(我以前从未做过),如果你们能引导我走上正确的道路,那将非常感激。

我目前在做什么: 我创建了一个映射XML,我已导入Excel。一旦将其导入Excel,用户将继续并在其中粘贴一些数据并将其导出以接收XML数据文件,然后用户可以将其放到FTP中,然后作业将其拾取并将其导入数据库。 / p>

这是问题所在: 导出具有以下节点,我不想要:

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

相反,我想用以下内容替换它:

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

如何自动执行此操作? Excel中是否有某种设置可以实现?

基本上,我希望导出有我的root而不是默认的root,我想自动将文件放到指定的路径:example:\ development \ school \ course import

谢谢!

1 个答案:

答案 0 :(得分:1)

我的同事实际上帮助了我。我以为我应该分享我的所作所为

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