Краткая справка:
Microsoft Excel — Программа для работы с электронными таблицами. Она предоставляет возможности экономико-статистических расчетов, графические инструменты и язык макропрограммирования VBA (Visual Basic for Application).
Visual Basic for Applications (VBA, Visual Basic для приложений) — немного упрощённая реализация языка программирования Visual Basic, встроенная в линейку продуктов Microsoft Office, а также во многие другие программные пакеты.
XML(англ. eXtensible Markup Language — расширяемый язык разметки). XML — язык с простым формальным синтаксисом, удобный для создания и обработки документов программами и одновременно удобный для чтения и создания документов человеком. Разработчик волен создать разметку в соответствии с потребностями к конкретной области, будучи ограниченным лишь синтаксическими правилами языка.
Задача:
Экспортировать данные из таблицы Excel и сформировать XML-файл с заданной структурой для последующей обработки сторонними программными продуктами.
Исходная таблица с некоторыми данными:
Код VBA:
Sub exportXML()
'Путь для сохранения итогового XML
xmlFile = ActiveWorkbook.Path & "export.xml"
'Строка и столбец расположения названия компании
Dim company_row As Integer
company_row = 1
Dim company_col As Integer
company_col = 1
'Номер строки начала таблицы с данными
Dim data_row As Integer
data_row = 3
'Номер столбца "Порядковый номер"
Dim num_col As Integer
num_col = 1
'Номер столбца "ФИО"
Dim name_col As Integer
name_col = 2
'Номер столбца "Профессия"
Dim profession_col As Integer
profession_col = 3
'Номер столбца "Наличность"
Dim profit_col As Integer
profit_col = 4
'Cоздание объекта XML
Set xml = CreateObject("MSXML2.DOMDocument")
'Добавление описания XML
xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
'Добавление корневого элемента "company"
Set Company = xml.createElement("company")
'Добавление атрибута "name"
Company.setAttribute "name", Cells(company_row, company_col)
xml.appendChild (Company)
'Цикл по строкам (пока не встретится строка с пустым "Порядковым номером")
Do While Not IsEmpty(Cells(data_row, num_col))
'Вызов функции добавления сотрудника компании
Company.appendChild (createPerson(xml, Cells(data_row, num_col), _
Cells(data_row, name_col), _
Cells(data_row, profession_col), _
Cells(data_row, profit_col)))
'Переход к следующей строке таблицы
data_row = data_row + 1
Loop
'Выполнение XSL-преобразования для добавления отступов в XML
Call transformXML(xml)
'Сохранение файла (без выбора пути сохранения, удобно при отладке)
'xml.Save xmlFile
'MsgBox "Export complete!"
'Сохранение файла (с выбором пути сохранения)
xml.Save Application.GetSaveAsFilename("", "Файл экспорта (*.xml),", , "Введите имя файла", "Сохранить")
End Sub
'Функция добавления сотрудника компании(xml, "Порядковый номер", "ФИО", "Профессия", "Наличность") возвращает узел XML
Function createPerson(ByRef xml As Variant, ByVal num As Variant, ByVal name As Variant, _
ByVal profession As Variant, ByVal profit As Variant) As Variant
'Создание элемента person
Set createPerson = xml.createElement("person")
createPerson.setAttribute "num", num
'Добавление в виде комментария "Профессия" (просто для примера)
createPerson.appendChild (xml.createComment(profession))
'Создание элементов для столбцов "ФИО" и "Наличность"
createPerson.appendChild(xml.createElement("name")).Text = name
createPerson.appendChild(xml.createElement("profit")).Text = profit
End Function
'Процедура для придания XML читабельного вида (с отступами)
Sub transformXML(ByRef xml As Variant)
'Cоздание объекта XSL
Set xsl = CreateObject("MSXML2.DOMDocument")
'Загрузка XSL из строки (не требует наличия отдельного XSL-файла)
xsl.LoadXML ("<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>" & vbCrLf & _
"<xsl:output method='xml' version='1.0' encoding='UTF-8' indent='yes'/>" & vbCrLf & _
"<xsl:template match='@*|node()'>" & vbCrLf & _
"<xsl:copy>" & vbCrLf & _
"<xsl:apply-templates select='@*|node()' />" & vbCrLf & _
"</xsl:copy>" & vbCrLf & _
"</xsl:template>" & vbCrLf & _
"</xsl:stylesheet>")
'Выполнение преобразования
xml.transformNodeToObject xsl, xml
End Sub
Результат в виде XML:
<?xml version="1.0" encoding="UTF-8"?> <company name="ООО 'Рога и копыта'"> <person num="1"> <!--Великий комбинатор--> <name>Остап Ибрагимович Бендер</name> <profit>225000</profit> </person> <person num="2"> <!--Нарушитель конвенции--> <name>Михаил Самуэлевич Паниковский</name> <profit>30000</profit> </person> <person num="3"> <!--Водитель автомобиля «Антилопа-Гну»--> <name>Адам Казимирович Козлевич</name> <profit>95000</profit> </person> <person num="4"> <!--Подпольный миллионер--> <name>Александр Иванович Корейко</name> <profit>1000000</profit> </person> <person num="5"> <!--Сын лейтенанта Шмидта--> <name>Шура Балаганов</name> <profit>50000</profit> </person> </company>
30.07.2015/
https://skynet48.ru/wp-content/uploads/2015/08/Advanced-Excel-VBA-Macros.png
283
343
admin
https://skynet48.ru/wp-content/uploads/2017/04/logo_skynet.png
admin2015-07-30 16:43:312018-06-20 11:41:49Экспорт из Excel в XML с помощью макроса на VBA
So, I’ve got a bunch of content that was delivered to us in the form of Excel spreadsheets. I need to take that content and push it into another system. The other system takes its input from an XML file. I could do all of this by hand (and trust me, management has no problem making me do that!), but I’m hoping there’s an easy way to write an Excel macro that would generate the XML I need instead. This seems like a better solution to me, as this is a job that will need to be repeated regularly (we’ll be getting a LOT of content in Excel sheets) and it just makes sense to have a batch tool that does it for us.
However, I’ve never experimented with generating XML from Excel spreadsheets before. I have a little VBA knowledge but I’m a newbie to XML. I guess my problem in Googling this is that I don’t even know what to Google for. Can anyone give me a little direction to get me started? Does my idea sound like the right way to approach this problem, or am I overlooking something obvious?
Thanks StackOverflow!
asked May 4, 2010 at 15:40
You might like to consider ADO — a worksheet or range can be used as a table.
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adPersistXML = 1
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
''It wuld probably be better to use the proper name, but this is
''convenient for notes
strFile = Workbooks(1).FullName
''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns, note also that you will need a different connection
''string for >=2007
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open strCon
rs.Open "Select * from [Sheet1$]", cn, adOpenStatic, adLockOptimistic
If Not rs.EOF Then
rs.MoveFirst
rs.Save "C:DocsTable1.xml", adPersistXML
End If
rs.Close
cn.Close
answered May 4, 2010 at 17:02
FionnualaFionnuala
90.1k7 gold badges110 silver badges148 bronze badges
2
Credit to: curiousmind.jlion.com/exceltotextfile (Link no longer exists)
Script:
Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)
Dim Q As String
Q = Chr$(34)
Dim sXML As String
sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
sXML = sXML & "<rows>"
''--determine count of columns
Dim iColCount As Integer
iColCount = 1
While Trim$(Cells(iCaptionRow, iColCount)) > ""
iColCount = iColCount + 1
Wend
Dim iRow As Integer
iRow = iDataStartRow
While Cells(iRow, 1) > ""
sXML = sXML & "<row id=" & Q & iRow & Q & ">"
For icol = 1 To iColCount - 1
sXML = sXML & "<" & Trim$(Cells(iCaptionRow, icol)) & ">"
sXML = sXML & Trim$(Cells(iRow, icol))
sXML = sXML & "</" & Trim$(Cells(iCaptionRow, icol)) & ">"
Next
sXML = sXML & "</row>"
iRow = iRow + 1
Wend
sXML = sXML & "</rows>"
Dim nDestFile As Integer, sText As String
''Close any open text files
Close
''Get the number of the next free text file
nDestFile = FreeFile
''Write the entire file to sText
Open sOutputFileName For Output As #nDestFile
Print #nDestFile, sXML
Close
End Sub
Sub test()
MakeXML 1, 2, "C:Usersjlyndsoutput2.xml"
End Sub
indofraiser
9943 gold badges17 silver badges50 bronze badges
answered Mar 13, 2014 at 10:30
SolataSolata
1,3943 gold badges29 silver badges42 bronze badges
3
Here is the example macro to convert the Excel worksheet to XML file.
#'vba code to convert excel to xml
Sub vba_code_to_convert_excel_to_xml()
Set wb = Workbooks.Open("C:temptestwb.xlsx")
wb.SaveAs fileName:="C:temptestX.xml", FileFormat:= _
xlXMLSpreadsheet, ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
This macro will open an existing Excel workbook from the C drive and Convert the file into XML and Save the file with .xml extension in the specified Folder. We are using Workbook Open method to open a file. SaveAs method to Save the file into destination folder. This example will be help full, if you wan to convert all excel files in a directory into XML (xlXMLSpreadsheet format) file.
answered Sep 3, 2020 at 8:31
This one more version — this will help in generic
Public strSubTag As String
Public iStartCol As Integer
Public iEndCol As Integer
Public strSubTag2 As String
Public iStartCol2 As Integer
Public iEndCol2 As Integer
Sub Create()
Dim strFilePath As String
Dim strFileName As String
'ThisWorkbook.Sheets("Sheet1").Range("C3").Activate
'strTag = ActiveCell.Offset(0, 1).Value
strFilePath = ThisWorkbook.Sheets("Sheet1").Range("B4").Value
strFileName = ThisWorkbook.Sheets("Sheet1").Range("B5").Value
strSubTag = ThisWorkbook.Sheets("Sheet1").Range("F3").Value
iStartCol = ThisWorkbook.Sheets("Sheet1").Range("F4").Value
iEndCol = ThisWorkbook.Sheets("Sheet1").Range("F5").Value
strSubTag2 = ThisWorkbook.Sheets("Sheet1").Range("G3").Value
iStartCol2 = ThisWorkbook.Sheets("Sheet1").Range("G4").Value
iEndCol2 = ThisWorkbook.Sheets("Sheet1").Range("G5").Value
Dim iCaptionRow As Integer
iCaptionRow = ThisWorkbook.Sheets("Sheet1").Range("B3").Value
'strFileName = ThisWorkbook.Sheets("Sheet1").Range("B4").Value
MakeXML iCaptionRow, iCaptionRow + 1, strFilePath, strFileName
End Sub
Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFilePath As String, sOutputFileName As String)
Dim Q As String
Dim sOutputFileNamewithPath As String
Q = Chr$(34)
Dim sXML As String
'sXML = sXML & "<rows>"
' ''--determine count of columns
Dim iColCount As Integer
iColCount = 1
While Trim$(Cells(iCaptionRow, iColCount)) > ""
iColCount = iColCount + 1
Wend
Dim iRow As Integer
Dim iCount As Integer
iRow = iDataStartRow
iCount = 1
While Cells(iRow, 1) > ""
'sXML = sXML & "<row id=" & Q & iRow & Q & ">"
sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
For iCOl = 1 To iColCount - 1
If (iStartCol = iCOl) Then
sXML = sXML & "<" & strSubTag & ">"
End If
If (iEndCol = iCOl) Then
sXML = sXML & "</" & strSubTag & ">"
End If
If (iStartCol2 = iCOl) Then
sXML = sXML & "<" & strSubTag2 & ">"
End If
If (iEndCol2 = iCOl) Then
sXML = sXML & "</" & strSubTag2 & ">"
End If
sXML = sXML & "<" & Trim$(Cells(iCaptionRow, iCOl)) & ">"
sXML = sXML & Trim$(Cells(iRow, iCOl))
sXML = sXML & "</" & Trim$(Cells(iCaptionRow, iCOl)) & ">"
Next
'sXML = sXML & "</row>"
Dim nDestFile As Integer, sText As String
''Close any open text files
Close
''Get the number of the next free text file
nDestFile = FreeFile
sOutputFileNamewithPath = sOutputFilePath & sOutputFileName & iCount & ".XML"
''Write the entire file to sText
Open sOutputFileNamewithPath For Output As #nDestFile
Print #nDestFile, sXML
iRow = iRow + 1
sXML = ""
iCount = iCount + 1
Wend
'sXML = sXML & "</rows>"
Close
End Sub
answered May 6, 2016 at 7:10
2
- Download source files — 3.33 KB
- Download demo project — 47.41 KB
Introduction
In Excel XP, there is a new export option for XML. However, what I get is many rubbish tags (I’m so disappointed…). Then, after searching on the Google (our nice search engine) for some time about «Converting Excel to XML», what I get are conversion tools that simply make a Rational table to XML. However, what I want is the support of nested structures (e.g. <data><field1>....</field1><data>). As a result, I decided to write my own using VBA… (don’t ask me why VBA… may be I will port it to my favorite C++ platform later. 
Using the Code
The source code contains 2 functions GenerateXMLDOM() and fGenerateXML(). They are actually doing the same thing in a different approach.
GenerateXMLDOM — Gives a Microsoft XMLDOM object which you can play with or serialize into an XML at any time using the «Save» method.
fGenerateXML — Generates a long string which is ready for output as file (more readable, as proper newline is added).
Both functions have the same parameters. The first one is rngData, which is the selected table area in the Excel Sheet for conversion. The second (rootNodeName) is the first/root node’s name used in the XML.
In the selected range, the first row is expected to be the field (or node) names. One thing that is worth noticing is that we can use the node name to define the level it belongs to. Started and separated by the node delimiter «/», the node name is one level deeper than the previous one. e.g. /data/field1 is equivalent to <data><field1>....</field1><data>, /student/name/surname is equivalent to <student><name><surname>.... </surname></name></student>:
Function GenerateXMLDOM(rngData As Range, rootNodeName As String) ... Function fGenerateXML(rngData As Range, rootNodeName As String) As String ...
Limitation and Notes
The ordering of fields may affect the generated XML, fields that have to be placed inside the same sub-node should be placed next to each other. For example, if /student/id and /student/name are placed next to each other, it will generate:
<student><id>..</id><name>...</name></student>
However, if not, the result will be:
<student><id>..</id></student> <somebrabra...> ... </somebrabra...> <student><name>..</name></student>
The reason is that it only checks with the last field instead of all before deciding where the node should be created.
Finally I would like to thank Hasler Thomas, the author of A Filebrowser for VBA, who provided the code for file browse. Hope this code will be useful for you. Please let me know if there are any bugs.
History
- 4 May 2004 — First release 0.8 version
- Работа с файлами XML
- Массивы
Функция Array2XML формирует из исходной таблицы объект типа DOMDocument, который можно выгрузить в XML-файл одной строкой кода (метод Save)
Sub XMLExport() Dim Заголовок As Range, Данные As Range Set Заголовок = Range("a1:f1") Set Данные = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, Заголовок.Columns.Count) arrHeaders = Application.Transpose(Application.Transpose(Заголовок.Value)) ПутьКФайлуXML = ThisWorkbook.Path & "result.xml" ' формируем DOMDocument, и сохраняем XML в файл result.xml Array2XML(Данные.Value, arrHeaders, "Root").Save ПутьКФайлуXML If Err = 0 Then MsgBox "Создан XML файл" & vbNewLine & ПутьКФайлуXML, vbInformation, "Готово" End Sub
Код функции Array2XML:
Function Array2XML(ByVal arrData, ByVal arrHeaders, ByVal strHeading$) As DOMDocument ' получает в качестве параметров: ' двумерный массив arrData с данными для выгрузки, ' одномерный массив arrHeaders, содержащий заголовки столбцов, ' и strHeading$ - XML-константу объекта Dim xmlDoc As DOMDocument, xmlFields As IXMLDOMElement, xmlField As IXMLDOMElement Set xmlDoc = CreateObject("Microsoft.XMLDOM") ' создаём новый DOMDocument DataColumnsCount% = UBound(arrData, 2) - LBound(arrData, 2) + 1 HeadersCount% = UBound(arrHeaders) - LBound(arrHeaders) + 1 If DataColumnsCount% <> HeadersCount% Then MsgBox "Количество заголовков в массиве arrHeaders" & _ "не соответствует количеству столбцов массива", vbCritical, "Ошибка создания XML": End xmlDoc.loadXML Replace("<" + strHeading + "/>", " ", "_") ' записываем XML-константу объекта For i = LBound(arrData) To UBound(arrData) ' создание нового узла Set xmlFields = xmlDoc.documentElement.appendChild(xmlDoc.createElement("Row")) For j = LBound(arrHeaders) To UBound(arrHeaders) ' добавление полей в узел Set xmlField = xmlFields.appendChild(xmlDoc.createElement(Replace(arrHeaders(j), " ", "_"))) xmlField.Text = arrData(i, j + LBound(arrData, 2) - LBound(arrHeaders)) Next j Next i Set Array2XML = xmlDoc End Function
Функция нашла применение в программе выгрузки тарифов в XML
- 27846 просмотров
Не получается применить макрос? Не удаётся изменить код под свои нужды?
Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.
So, I’ve got a bunch of content that was delivered to us in the form of Excel spreadsheets. I need to take that content and push it into another system. The other system takes its input from an XML file. I could do all of this by hand (and trust me, management has no problem making me do that!), but I’m hoping there’s an easy way to write an Excel macro that would generate the XML I need instead. This seems like a better solution to me, as this is a job that will need to be repeated regularly (we’ll be getting a LOT of content in Excel sheets) and it just makes sense to have a batch tool that does it for us.
However, I’ve never experimented with generating XML from Excel spreadsheets before. I have a little VBA knowledge but I’m a newbie to XML. I guess my problem in Googling this is that I don’t even know what to Google for. Can anyone give me a little direction to get me started? Does my idea sound like the right way to approach this problem, or am I overlooking something obvious?
Thanks StackOverflow!
asked May 4, 2010 at 15:40
You might like to consider ADO — a worksheet or range can be used as a table.
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adPersistXML = 1
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
''It wuld probably be better to use the proper name, but this is
''convenient for notes
strFile = Workbooks(1).FullName
''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns, note also that you will need a different connection
''string for >=2007
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
cn.Open strCon
rs.Open "Select * from [Sheet1$]", cn, adOpenStatic, adLockOptimistic
If Not rs.EOF Then
rs.MoveFirst
rs.Save "C:DocsTable1.xml", adPersistXML
End If
rs.Close
cn.Close
answered May 4, 2010 at 17:02
FionnualaFionnuala
90.1k7 gold badges110 silver badges148 bronze badges
2
Credit to: curiousmind.jlion.com/exceltotextfile (Link no longer exists)
Script:
Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFileName As String)
Dim Q As String
Q = Chr$(34)
Dim sXML As String
sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
sXML = sXML & "<rows>"
''--determine count of columns
Dim iColCount As Integer
iColCount = 1
While Trim$(Cells(iCaptionRow, iColCount)) > ""
iColCount = iColCount + 1
Wend
Dim iRow As Integer
iRow = iDataStartRow
While Cells(iRow, 1) > ""
sXML = sXML & "<row id=" & Q & iRow & Q & ">"
For icol = 1 To iColCount - 1
sXML = sXML & "<" & Trim$(Cells(iCaptionRow, icol)) & ">"
sXML = sXML & Trim$(Cells(iRow, icol))
sXML = sXML & "</" & Trim$(Cells(iCaptionRow, icol)) & ">"
Next
sXML = sXML & "</row>"
iRow = iRow + 1
Wend
sXML = sXML & "</rows>"
Dim nDestFile As Integer, sText As String
''Close any open text files
Close
''Get the number of the next free text file
nDestFile = FreeFile
''Write the entire file to sText
Open sOutputFileName For Output As #nDestFile
Print #nDestFile, sXML
Close
End Sub
Sub test()
MakeXML 1, 2, "C:Usersjlyndsoutput2.xml"
End Sub
indofraiser
9943 gold badges17 silver badges50 bronze badges
answered Mar 13, 2014 at 10:30
SolataSolata
1,3943 gold badges29 silver badges42 bronze badges
3
Here is the example macro to convert the Excel worksheet to XML file.
#'vba code to convert excel to xml
Sub vba_code_to_convert_excel_to_xml()
Set wb = Workbooks.Open("C:temptestwb.xlsx")
wb.SaveAs fileName:="C:temptestX.xml", FileFormat:= _
xlXMLSpreadsheet, ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
This macro will open an existing Excel workbook from the C drive and Convert the file into XML and Save the file with .xml extension in the specified Folder. We are using Workbook Open method to open a file. SaveAs method to Save the file into destination folder. This example will be help full, if you wan to convert all excel files in a directory into XML (xlXMLSpreadsheet format) file.
answered Sep 3, 2020 at 8:31
This one more version — this will help in generic
Public strSubTag As String
Public iStartCol As Integer
Public iEndCol As Integer
Public strSubTag2 As String
Public iStartCol2 As Integer
Public iEndCol2 As Integer
Sub Create()
Dim strFilePath As String
Dim strFileName As String
'ThisWorkbook.Sheets("Sheet1").Range("C3").Activate
'strTag = ActiveCell.Offset(0, 1).Value
strFilePath = ThisWorkbook.Sheets("Sheet1").Range("B4").Value
strFileName = ThisWorkbook.Sheets("Sheet1").Range("B5").Value
strSubTag = ThisWorkbook.Sheets("Sheet1").Range("F3").Value
iStartCol = ThisWorkbook.Sheets("Sheet1").Range("F4").Value
iEndCol = ThisWorkbook.Sheets("Sheet1").Range("F5").Value
strSubTag2 = ThisWorkbook.Sheets("Sheet1").Range("G3").Value
iStartCol2 = ThisWorkbook.Sheets("Sheet1").Range("G4").Value
iEndCol2 = ThisWorkbook.Sheets("Sheet1").Range("G5").Value
Dim iCaptionRow As Integer
iCaptionRow = ThisWorkbook.Sheets("Sheet1").Range("B3").Value
'strFileName = ThisWorkbook.Sheets("Sheet1").Range("B4").Value
MakeXML iCaptionRow, iCaptionRow + 1, strFilePath, strFileName
End Sub
Sub MakeXML(iCaptionRow As Integer, iDataStartRow As Integer, sOutputFilePath As String, sOutputFileName As String)
Dim Q As String
Dim sOutputFileNamewithPath As String
Q = Chr$(34)
Dim sXML As String
'sXML = sXML & "<rows>"
' ''--determine count of columns
Dim iColCount As Integer
iColCount = 1
While Trim$(Cells(iCaptionRow, iColCount)) > ""
iColCount = iColCount + 1
Wend
Dim iRow As Integer
Dim iCount As Integer
iRow = iDataStartRow
iCount = 1
While Cells(iRow, 1) > ""
'sXML = sXML & "<row id=" & Q & iRow & Q & ">"
sXML = "<?xml version=" & Q & "1.0" & Q & " encoding=" & Q & "UTF-8" & Q & "?>"
For iCOl = 1 To iColCount - 1
If (iStartCol = iCOl) Then
sXML = sXML & "<" & strSubTag & ">"
End If
If (iEndCol = iCOl) Then
sXML = sXML & "</" & strSubTag & ">"
End If
If (iStartCol2 = iCOl) Then
sXML = sXML & "<" & strSubTag2 & ">"
End If
If (iEndCol2 = iCOl) Then
sXML = sXML & "</" & strSubTag2 & ">"
End If
sXML = sXML & "<" & Trim$(Cells(iCaptionRow, iCOl)) & ">"
sXML = sXML & Trim$(Cells(iRow, iCOl))
sXML = sXML & "</" & Trim$(Cells(iCaptionRow, iCOl)) & ">"
Next
'sXML = sXML & "</row>"
Dim nDestFile As Integer, sText As String
''Close any open text files
Close
''Get the number of the next free text file
nDestFile = FreeFile
sOutputFileNamewithPath = sOutputFilePath & sOutputFileName & iCount & ".XML"
''Write the entire file to sText
Open sOutputFileNamewithPath For Output As #nDestFile
Print #nDestFile, sXML
iRow = iRow + 1
sXML = ""
iCount = iCount + 1
Wend
'sXML = sXML & "</rows>"
Close
End Sub
answered May 6, 2016 at 7:10
2