Excel zu XML per VBA, Zeilen in XML gruppieren
29.10.2017 15:58:10
AmBall
Hat hier jemand eine Lösung, wie man den bestehenden Code entsprechend umschreiben kann ohne Hilfsspalten verwenden zu müssen? Meine Idee war die gleichen Werte mittels Range zu definieren, aber mein Wissen über VBA reicht bei weitem nicht aus um das umzusetzen.
Danke für Eure Hilfe!
Sub XML_Export()
'** Excel-Inside Solutions - (C) 9.1.2015*
'** Dimensionierung der Variablen
Dim strFile As String, Text As String
Dim lngRow, lngCol As Long
Dim varShow
Dim lngLz As Long
'** Vorgaben definieren
Set wsakt = ActiveSheet
'** Errorhandling
On Error GoTo Fehlermeldung
'** XML-Dateipfad und -Name festlegen
strFile = ThisWorkbook.Path & "\cdiscount-orders.xml"
'** Datei (ASCII) öffnen
Open strFile For Output As #1
'** Ermittlung der letzten Zeile
lngLz = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'** XML-Header schreiben
Print #1, " "
Print #1, ""
'** Mit Schleife die Spalten der Tabelle schreiben
For lngRow = 7 To lngLz
If wsakt.Cells(lngRow, 2).Value > 0 Then
'** Schreiben Datensatz-Beginn
Print #1, " " 'Tag Anfang"
'** Schreiben der Felder
Print #1, "" & Cells(lngRow, 2) & " "
Print #1, "" & Cells(lngRow, 3) & " "
Print #1, "" & Cells(lngRow, 1) & " "
Print #1, ""
Print #1, "" & Cells(lngRow, 7) & " "
Print #1, "" & Cells(lngRow, 9) & " "
Print #1, "" & Cells(lngRow, 13) & " "
Print #1, "" & Cells(lngRow, 14) & " "
Print #1, " "
Print #1, ""
Print #1, "" & "Versand" & " "
Print #1, "" & Cells(lngRow, 15) & " "
Print #1, "" & 1 & " "
Print #1, " "
Print #1, ""
Print #1, "" & Cells(lngRow, 18) & " "
Print #1, "" & Cells(lngRow, 19) & " "
Print #1, "" & Cells(lngRow, 20) & " "
Print #1, "" & Cells(lngRow, 21) & " "
Print #1, "" & Cells(lngRow, 22) & " "
Print #1, "" & Cells(lngRow, 23) & " "
Print #1, "" & Cells(lngRow, 24) & " "
Print #1, " "
Print #1, ""
Print #1, "" & Cells(lngRow, 27) & " "
Print #1, "" & Cells(lngRow, 28) & " "
Print #1, "" & Cells(lngRow, 30) & " "
Print #1, "" & Cells(lngRow, 29) & " "
Print #1, "" & Cells(lngRow, 31) & " "
Print #1, " "
'** Schreiben Datensatz-Ende
Print #1, " "
End If
Next lngRow
'** Daten-Tag schließen
Print #1, " "
'** XML-Datei schließen
Close #1
'** Aufruf des Editors mit der geschriebenen xml-Datei
varShow = Shell(Environ("windir") & "\notepad.exe " & strFile, 1)
Exit Sub
'** Errorhandling
Fehlermeldung:
Close #1
MsgBox "Fehler-Nr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
End Sub