¿Cómo generar XML desde una macro de Excel VBA?

Question

Por lo tanto, tengo un montón de contenido que se nos entregó en forma de hojas de cálculo de Excel. Necesito tomar ese contenido e insertarlo en otro sistema. El otro sistema toma su entrada de un archivo XML. Podría hacer todo esto a mano (¡y créame, la administración no tiene problemas para hacer que lo haga!), Pero espero que haya una manera fácil de escribir una macro de Excel que genere el XML que necesito en su lugar. Esta parece ser una mejor solución para mí, ya que este es un trabajo que deberá repetirse regularmente (obtendremos MUCHO contenido en hojas de Excel) y tiene sentido tener una herramienta por lotes que lo haga por nosotros. .

Sin embargo, nunca antes había experimentado con la generación de XML a partir de hojas de cálculo de Excel. Tengo un poco de conocimiento de VBA, pero soy un novato en XML. Creo que mi problema al buscar en Google esto es que ni siquiera sé a qué a buscar en Google. ¿Alguien puede darme una pequeña dirección para comenzar? ¿Mi idea suena como la forma correcta de abordar este problema, o estoy pasando por alto algo obvio?

Gracias StackOverflow!

Answer 1

Consulte Export Excel to XML in VBA para obtener ayuda.

Answer 2

Quizás desee considerar ADO: una hoja de trabajo o rango se puede usar como una tabla.

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

crédito a: curiousmind.jlion.com/exceltotextfile (Enlace ya no existe)

Guión:

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

Ésta versión más - esto ayudará en genérico

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