Для работы с XML в VBA, нужно включить Microsoft XML, vN.N (Tools -> References)
Например, есть XML-файлы (input_NN), которые нужно единообразно преобразовать в другой XML (processed_input_NN) с помощью XSLT-шаблона.
Реализацию подобного примера можно скачать тут: Converter xsl Example.zip
VBA-код:
Sub Convert()
On Error GoTo Error
Dim path As String: path = Application.ActiveWorkbook.path & "\Input_Output\" 'Взять папку Input_Output
Dim inFile As String: inFile = Dir(path & "*.xml", vbNormal) 'Просканировать каталог, найти первый файл .xml и положить его имя в переменную
While inFile <> ""
If InStr(1, inFile, "processed_") <> 1 Then 'взять любые .xml, кроме уже обработанных
Log.writeLine "Processing " & inFile
Dim docInput As DOMDocument60: Set docInput = New DOMDocument60: docInput.Load path & inFile 'подготовить DOM-объект для чтения и считать input-файл
Call TransformAndSave(path, inFile, docInput)
End If
inFile = Dir 'продолжить чтение папки на следующий .xml
Wend
Exit Sub
Error:
Log.writeLine "Error: " & Err.Description & Err.Source
Resume Next
End Sub
Sub TransformAndSave(path As String, inFile As String, docInput As DOMDocument60)
Dim template As New DOMDocument60: template.Load path & "convert.xslt" 'подготовить DOM-объект для чтения и считать xsl-файл
Dim outputName As String: outputName = "processed_" & inFile 'имя файла output
Log.writeLine "Creating " & outputName
Dim docOutput As New DOMDocument60 'подготовить DOM-объект для результата трансформации
docInput.transformNodeToObject template, docOutput 'трансформировать
Common.SaveString path & outputName, Common.PrettyPrintXml(docOutput)
End Sub
Sub SaveString(file As String, content As String)
' сохраняет строку в utf-8
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data
fsT.Charset = "utf-8" 'Specify charset For the source text data
fsT.Open
fsT.WriteText content
fsT.SaveToFile file, 2 'Save binary data To disk
End Sub
Function PrettyPrintXml(ByVal dom As Variant) As String 'из xml-строки делает форматированный xml
Dim writer As New MXXMLWriter60
With writer
.omitXMLDeclaration = False
.indent = True
.byteOrderMark = False
.standalone = False
End With
Dim reader As New SAXXMLReader60
Set reader.contentHandler = writer
reader.Parse dom
PrettyPrintXml = writer.output
PrettyPrintXml = Replace(PrettyPrintXml, "encoding=""UTF-16""", "encoding=""UTF-8""") ' windows-1251
PrettyPrintXml = Replace(PrettyPrintXml, " standalone=""no""", "")
End Function
Dim LogBox As MSForms.TextBox 'TextBox on the form
Sub init(ByRef n As MSForms.TextBox) 'initiate and clear TextBox
Set LogBox = n
LogBox.text = ""
End Sub
Sub writeLine(text As String) 'add line to TextBox
LogBox.text = LogBox.text & text & vbNewLine
End Sub