Sheet-Inhalt in XML-Datei speichern
26.05.2020 19:30:59
Christian
ich benötige Eure Hilfe für ein Thema, was sich einfach anhört, wobei ich aber etwas verzweifle:
Ich habe über in einem Excel-Sheet "XML" eine XML-Struktur zusammengebaut, welche ich momentan markiere und dann in eine Textdatei kopiere, welche dann in *.xml umbenannt wird.
Dieses wollte ich gerne per Button machen, da der Name der XML-Datei sich u.a. auch aus einer Zelle in einem anderen Excel-Sheet "Eingabe" Zelle K5 zusammengesetzt wird.
Ein Abspeichern des Sheets per Datei - Speichern unter "txt" funktioniert nicht sauber - Umlaute äüö werden als "komische Zeichen" in Notepad++ angezeigt. Ein anderen Weg hat mit die Struktur zwar abgespeichert, jedoch an einigen Stellen einfach Anführungszeichen am Anfang "" gesetzt. Somit ließ die Struktur sich nicht weiterverarbeiten.
Eine Excel-Beispieldatei habe hier beigefügt - https://www.herber.de/bbs/user/137765.xlsm
Ich bin für jeden Tipp dankbar ...
Viele Grüße
Christian
Variante 1:
Private Sub CommandButton2_Click()
Dim Bereich As Range, Zeile As Long, Spalte As Long
Dim AusZelle As String
Set Bereich = ThisWorkbook.Worksheets("XML").Range("A1:C63")
AusZelle = InputBox("Bitte die PM-Nummer des Prüfmittels eingeben." & vbNewLine & vbNewLine & " _
Unter dieser Nummer wird die Auswertung im Pfad" & vbNewLine & "C:\TEMP\XML-Dateien\" & vbNewLine & "gespeichert ..." & vbNewLine & vbNewLine & "YYYYMMMDD_PM-Nmmer_EXT:", , ThisWorkbook.Worksheets("Eingabe").Range("K5"))
Open "C:\TEMP\XML-Dateien\" & Format(Date, "YYYYMMDD") & "_" & AusZelle & "_EXT" + ".xml" For _
Output As #1
For Zeile = 0 To Bereich.Rows.Count - 1
For Spalte = 0 To Bereich.Columns.Count - 1
Print #1, Bereich.Cells(1).Offset(Zeile, Spalte).Value & " ";
Next Spalte
Print #1,
Next Zeile
Close #1
MsgBox "Die Datei wurde unter" & vbNewLine & vbNewLine & "C:\TEMP\XML-Dateien\" & Format(Date, " _
YYYYMMDD") & "_" & AusZelle & "_EXT" + ".xml" & vbNewLine & vbNewLine & "gespeichert !", vbibformation
End Sub
Variante 2:
Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Porsche XML").Copy
Dim neuName As String
neuName = InputBox("Bitte die PM-Nummer des Prüfmittels eingeben." & vbNewLine & vbNewLine & " _
Unter dieser Nummer wird die Auswertung im Pfad" & vbNewLine & "C:\TEMP\XML-Dateien\" & vbNewLine & "gespeichert ..." & vbNewLine & vbNewLine & "PM-Nmmer:", , ThisWorkbook.Worksheets("Eingabe").Range("K5"))
'Pfad anpassen "D:\?\
Application.DisplayAlerts = False 'Fehlermeldungen aus
ActiveWorkbook.SaveAs Filename:="C:\TEMP\XML-Dateien\" & neuName & ".xml", FileFormat:= _
xlTextWindows, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True ' Fehlermeldungen an
'Pfad anpassen "D:\?\
MsgBox "Die Datei wurde unter" & vbNewLine & vbNewLine & "C:\TEMP\XML-Dateien\" & neuName & ". _
xml" & vbNewLine & vbNewLine & "gespeichert !", vbibformation
Application.ScreenUpdating = True
End Sub
Anzeige