Как сгенерировать XML из макроса Excel VBA?

Question

Итак, у меня есть куча контента, который был доставлен нам в виде электронных таблиц Excel. Мне нужно взять этот контент и нажать его в другую систему. Другая система берет свой вход из файла XML. Я мог бы сделать все это вручную (и поверьте мне, у руководства нет проблем, заставляя меня это делать!), Но я надеюсь, что есть простой способ написать макрос Excel, который будет генерировать XML, в котором я нуждаюсь. Это кажется лучшим решением для меня, поскольку это работа, которую нужно регулярно повторять (мы будем получать много контента в листах Excel), и имеет смысл иметь пакетный инструмент, который делает это для нас ,

Однако я никогда не экспериментировал с генерацией XML из таблиц Excel раньше. У меня есть небольшое знание VBA, но я новичок в XML. Я предполагаю, что моя проблема в Googling заключается в том, что я даже не знаю, что для Google. Может ли кто-нибудь дать мне небольшое направление, чтобы начать меня? Является ли моя идея правильной, как подход к этой проблеме, или я не замечаю ничего очевидного?

Спасибо StackOverflow!

Answer 1

См. Export Excel to XML in VBA за помощью.

Answer 2

Возможно, вам стоит рассмотреть ADO - рабочий лист или диапазон могут использоваться в качестве таблицы.

не

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:\Docs\Table1.xml", adPersistXML 
End If 

rs.Close 
cn.Close 

Answer 3

Кредит: curiousmind.jlion.com/exceltotextfile (ссылка больше не существует)

Сценарий:

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:\Users\jlynds\output2.xml" 
End Sub 

Answer 4

Это еще одна версия - это поможет в родовом

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