Hallo zusammen ich habe folgendes Problem:
ich möchte aus einem Excel Tabellenblatt eine XML Datei erstellen. Das Klappt auch schon ganz gut. Allerdings müssten für die XML ein paar Zeichen ersetzt werden.
wie die Umlaute, ß und Leerschritte da die XML sonst nicht eingelesen werden kann. Das ersetzen müsse während dem Print ausdruck erfolgen.
Irgendwie komm ich da grad nicht weiter. Vielleicht kann mir jemand helfen?
Sub stamm()
Application.DecimalSeparator = "."
Application.ThousandsSeparator = ""
Application.UseSystemSeparators = False
'falls die Zieldatei noch nicht vorhanden ist,
'wird sie erstellt
Dim Datei As String, Text As String
Dim Zeile As Long
Dim zeigen
Dim GanzeZeile As String
ze_last = ActiveCell.SpecialCells(xlLastCell).Row
ze_lasta = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
'## Tabellenblatt und Spalte an deine Bedürfnisse anpassen
Set rngBereich = ActiveSheet.Range("A1:AM" & Cells(Rows.Count, 1).End(xlUp).Row) 'A1 bis letzte in A
'## Tabellenblatt und Spalte an deine Bedürfnisse anpassen
ActiveSheet.Columns("A:ZZ").NumberFormat = "@" 'Spalte A Format Text
For Each rngZelle In rngBereich
rngZelle = Replace(rngZelle, ",", ".") 'Komma durch Punkt ersetzen
rngZelle = Replace(rngZelle, "ä", "ae") '
rngZelle = Replace(rngZelle, "Ö", "oe") '
rngZelle = Replace(rngZelle, "ü", "ue") '
rngZelle = Replace(rngZelle, "ß", "ss") '
Next rngZelle
On Error GoTo Fehler
'Zieldatei festlegen
Datei = "C:\kuhnle\" & "BDEStamm.xml"
'GanzeZeile = GanzeZeile & Trennzeichen & Cells(Zeile, Spalte).Value
Open Datei For Output As #1 'Zieldatei öffnen
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & " standalone=" & Chr(34) & "no" & Chr(34) & "?> <DBData xmlns=" & Chr(34) & "http://tempuri.org/DBData.xsd" & Chr(34) & "><Mitarbeiter><Kurzzeichen>1</Kurzzeichen><Name>Michael Ruppert</Name></Mitarbeiter>" & "<Mitarbeiter><Kurzzeichen>5</Kurzzeichen><Name>Julian Krause</Name></Mitarbeiter>" & "<Mitarbeiter><Kurzzeichen>3</Kurzzeichen><Name>Gregor Berendt</Name></Mitarbeiter>"
For Zeile = 2 To ze_lasta
'reinschreiben
Print #1, "<Auftraege><Auftrags-Kurzz.>" & Cells(Zeile, 5) & "</Auftrags-Kurzz.>" & "<Kunden-Kurzz.>" & Cells(Zeile, 6) & "</Kunden-Kurzz.><Auftrags-Text>" & Cells(Zeile, 10) & "</Auftrags-Text></Auftraege>"
Next Zeile
For Zeile = 2 To ze_last
'reinschreiben
Print #1, Cells(Zeile, 39)
Next Zeile
Print #1, "</DBData>"
Close #1 'Zieldatei schließen
Exit Sub
Fehler:
Close #1
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
End Sub
|