Создание макроса Excel для экспорта XML в определенную папку
Мне нужно создать макрос (чего я никогда раньше не делал), и если вы, ребята, сможете направить меня по правильному пути, это будет очень признательно.
Что я сейчас делаю: я создал сопоставительный XML, который импортировал в Excel. После того, как он будет импортирован в Excel, пользователи затем будут вставлять в него некоторые данные и экспортировать их, чтобы получить файл данных XML, который затем пользователь сможет перетащить на FTP, где задание заберет его и импортирует в базу данных.
Вот проблема: экспорт имеет следующий узел, который я не хочу:
<?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, которые могли бы сделать это?
По сути, я хочу, чтобы экспорт имел мой корень вместо корня по умолчанию, и я хочу, чтобы автоматически была возможность перетаскивать файл по указанному пути: пример: \development\school\course import
Спасибо!
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