domanskiy

'Читаем данные из XLS файла
Dim connStr, objConn, getNames, inputFile 
inputFile  = test.xls
connStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & inputFile & ";Extended Properties=""Excel 12.0 xml;HDR=No;IMEX=2;"";"

Set objConn = CreateObject("ADODB.Connection")
'Open Connection
objConn.open connStr

'Define recordset and SQL query
'тут мы через SQL запрос вытаскиваем данные из ИМЕННЫХ ячеек экселевского файла. Всё это в массив
Set rs = objConn.execute("SELECT * FROM Job,Customer,Prod")

'присваиваем значения переменным из массива
DO WHILE NOT rs.EOF
Job = rs.Fields(0)
Customer = rs.Fields(1)
Prod = rs.Fields(2)
rs.MoveNext
Loop

'Close connection XLS and release objects
objConn.Close
Set rs = Nothing
Set objConn = Nothing

'формируем XML
Dim  rootNode, subNode, xmlDoc, commentItem, Fragment
Set xmlDoc = CreateObject("Msxml2.DOMDocument")
'Создание объявления XML
xmlDoc.appendChild(xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'"))

'Создание корневого элемента
Set rootNode = xmlDoc.CreateElement("JOBS")
xmlDoc.AppendChild rootNode

Set subNode = rootNode.appendChild(xmlDoc.createElement("Job"))
subNode.text = Job

Set subNode = rootNode.appendChild(xmlDoc.createElement("Customer"))
subNode.text = Customer

Set subNode = rootNode.appendChild(xmlDoc.createElement("Prod"))
subNode.text = Prod

'* -- написание XML-файла с отступом для более легкого использования независимо от того, какая программа использовалась для просмотра или редактирования файла -- *'
Dim rdr, wrt, oStream
Set rdr = CreateObject("MSXML2.SAXXMLReader")
Set wrt = CreateObject("MSXML2.MXXMLWriter")

Set oStream = CreateObject("ADODB.STREAM")
oStream.Open
oStream.Charset = "UTF-8"
 
wrt.Indent = True
wrt.Encoding = "UTF-8"
wrt.Output = oStream
Set rdr.ContentHandler = wrt
Set rdr.ErrorHandler = wrt
rdr.Parse xmlDoc
wrt.Flush

'запись xml файла
oStream.SaveToFile "Test.xml", 2

Set rdr = Nothing
Set wrt = Nothing