Wie generiert man XML aus einem Excel VBA-Makro?

Question

Also, ich habe eine Reihe von Inhalten, die uns in Form von Excel-Tabellen geliefert wurden. Ich muss diesen Inhalt nehmen und ihn in ein anderes System übertragen. Das andere System nimmt seine Eingabe aus einer XML-Datei. Ich könnte all das von Hand machen (und mir vertrauen, das Management hat kein Problem, mich dazu zu bringen!), Aber ich hoffe, dass es einen einfachen Weg gibt, ein Excel-Makro zu schreiben, das stattdessen das XML generiert, das ich brauche. Dies scheint mir eine bessere Lösung zu sein, da dies ein Job ist, der regelmäßig wiederholt werden muss (wir werden eine Menge Inhalt in Excel-Tabellen bekommen) und es macht einfach Sinn, ein Batch-Tool zu haben, das es für uns erledigt .

Allerdings habe ich noch nie zuvor mit der Generierung von XML aus Excel-Tabellen experimentiert. Ich habe ein wenig VBA-Kenntnisse, aber ich bin ein Neuling zu XML. Ich denke, mein Problem beim Googlen ist, dass ich nicht einmal weiß, wofür ich Google brauche. Kann mir jemand eine kleine Anweisung geben, damit ich anfangen kann? Klingt meine Idee nach dem richtigen Weg, um dieses Problem anzugehen, oder übersehe ich etwas Offensichtliches?

Danke StackOverflow!

Answer 1

Siehe Export Excel to XML in VBA für Hilfe.

Answer 2

Sie könnten ADO in Betracht ziehen - ein Arbeitsblatt oder ein Bereich kann als Tabelle verwendet werden.

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

Credit: curiousmind.jlion.com/exceltotextfile (Link existiert nicht mehr)

Drehbuch:

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

Dieses eine weitere Version - diese

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 

in generic

helfen