XML importieren um zu vergleichen
06.04.2016 21:39:16
PaulB
Ein neues Makro steht wieder an.
Ich will 2 Konfigurationsdateien (= Format.XML) miteinander vergleichen um eventuelle Unterschiede sichtbar zu machen.
Dafür ist es erforderlich dass beide Dateien in einer Arbeitsmappe sind.
Um dies einfach hin zu bekommen habe 2 Arbeitsblätter erzeugt und in "site1" und "site2" umbenannt
- dann beide Dateien in die jeweiligen Arbeitsblätter importiert
- sowie einige überflüssige Kolonnen gelöscht
- Danach wird der gesamte Inhalt z.b. von site2 markiert
- Dann bedingte Formatierung - eigene rule: "=A1site1!A1"
- und dann noch bei der Formatierung festgelegt dass Unterschiede GELB markiert werden.
So weit so gut. Von Hand klappt das.
Ich habe folgendes Makro aufgezeichnet.
Sub ELTEK_Compare()
' ELTEK_Compare Macro
' Keyboard Shortcut: Ctrl+e
ActiveWorkbook.XmlImport URL:="E:\Eltek-Trier-10-2015.xml", ImportMap _
:=Nothing, Overwrite:=True, Destination:=Range("$A$1")
Sheets.Add After:=ActiveSheet
ActiveWorkbook.XmlImport URL:="E:\Eltek-Trier-11-12-2015.xml", _
ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "site2"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "site1"
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Sheets("site2").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Cells.Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=A1site1!A1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A2").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\ti02084\Documents\ELTEK-Compare.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
End Sub
-----------------------------------------
Ich mochte nun das Makro etwas anpassen.
Als Ausgangsordner habe ich als c:\ELTEK-Compare festgelegt.
Es soll möglich sein dort eine beliebige XML-Datei anzuwählen.
Sowohl für die erste als auch für die zweite Konfigurationsdatei
Die finale Arbeitsmappe soll auch dort abgespeichert werden.
Dessen Name soll aus dem Namen der als ersten importierten Konfigurationsdatei vorgeschlagen werden.
Hier ist mein Versuch um das Makro anzupassen.
Allerdings stoppt das Ding bereits bei:
ActiveWorkbook.XmlImport Filename:
Es wäre toll wenn jemand mir einen Schupps geben könnte .
Vielen Dank 69
mfg.
Sub ELTEK_Compare()
' Created 06.04.2016
' ELTEK_Compare Macro
' Keyboard Shortcut: Ctrl+e
Dim varName As Variant
Dim strName As String
Dim Neuer_Dateiname As String
Dim strTabname As String
Dim strPfad As String
'Pfad festlegen
strPfad = "C:\ELTEK-Compare\"
'Laufwerk und Pfad zum Öffnen vorgeben
ChDrive "C"
ChDir strPfad
'Datei-Öffnen-Dialog aufrufen
varName = Application.GetImportFilename("XML-Dateien (*.XML),*.xml")
'Letztes \ ermitteln um Pfad und Dateiname zu trennen
strName = Right$(varName, Len(varName) - InStrRev(varName, "\"))
'Letzten . ermitteln um Dateiname und Erweiterung zu trennen
strName = Left(strName, InStrRev(strName, ".") - 1)
ActiveWorkbook.XmlImport Filename:=varName, Origin:=xlWindows, ImportMap _
:=Nothing, Overwrite:=True, Destination:=Range("$A$1")
Sheets.Add After:=ActiveSheet
ActiveWorkbook.XmlImport URL:="C:\ELTEK-Compare\", _
ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "site2"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "site1"
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Sheets("site2").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Cells.Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=A1site1!A1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A2").Select
'Speichern-unter Dialog aufrufen
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:=strPfad & strName & ".xlsx", _
_
_
fileFilter:="Excel-Arbeitsmappe, *.xlsx")
'falls Abbrechen gedrückt wird, Makro verlassen
If Neuer_Dateiname = "Falsch" Then
'Meldung Makroabbruch
MsgBox "Workbook not saved!", 48, "Abort by user"
Exit Sub
Else
'aktive Arbeitsmappe speichern
ActiveWorkbook.SaveAs Filename:=Neuer_Dateiname, FileFormat:=51
End If
End Sub