XSLT | Вызов через VBA

Для работы с 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

 
 
 

 

 



© 2006-2021 | Анна Петросян | pashelp@yandex.ru