XLM-Dateien importieren um zu vergleichen

[PaulB]

Hallo

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: "=A1<>site1!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.

Code:

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:= _
        "=A1<>site1!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.

Code:

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:= _
        "=A1<>site1!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

[Fennek]

Hallo,

hast du schon einmal getestet, ob dieser Ansatz deine Bedürfnisse erfüllt?

Cmd - Fenster öffen (Ausführen -> cmd.exe)

Comp /?

Da erhälst du alle Varianten des Befehls.


Mfg

[schauan]

Hallöchen,

in den beiden geposteten codes steht bis auf einen Fall immer URL und nicht Filename

Eine andere Alternative zum Dateivergleich wäre übrigens Notepad++ oder pspad. Gibt's beides auch in portablen Versionen. Ist aber eben alles manuell zu handeln

[PaulB]

Danke euch beiden.

comp /? habe ich noch nicht versucht.
Ich werde es zwar versuchen, aber ich denke dass das schwierig wird.
Da kommt doch bestimmt nicht umhin die beiden Dateinamen von Hand einzugeben. Klar.
Das Resultat muss wahrscheinlich ausgewählt werden (ctrl A und dann mit ctrl V wieder in ein Editor eingefügt werden.

Da ist die Sache mit EXCEL (auch wenn man alles jedesmal von Hand machen muss) einfacher.
Zudem sind Unterschiede gelb unterlegt und man kann irrelevante Kolonnen löschen.

@schauan.

Das mit nur einmal Filename ist mir bewusst.
Im auf gezeichneten Makro habe ich beide Konfigurationsdateien ja von Hand ausgewählt.
In dem unteren Makro war ich dabei anzupassen.
Aber wie ich geschrieben habe "stoppt das Ding bereits bei:
                                         ActiveWorkbook.XmlImport Filename:"

Deshalb bin ich dann mit der Anpassung für die 2. Datei erstmal nicht weitergefahren.

Die zu bearbeitenden Dateien sollten frei wählbar sein.
Die Namen der Dateien nicht alle gleich.

mfg

[Kuwer]

Hallo,

wenn Du die richtige Syntax (so wie für die 2. Datei) verwendest, sollte das schon klappen:

ActiveWorkbook.XmlImport URL:=varName, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

Gruß Uwe

[PaulB]

Hallo

Danke Uwe für deine Antwort.


Ich habe jetzt zum öffnen der ersten Datei: URL:=varName eingegeben.

Das hat auch geklappt. Super.


In der Zeile für die Auswahl der zweiten Datei habe ich ebenso: URL:=varName eingegeben

in der Hoffnung dass ich die Datei von Hand auswählen könnte.


Dem ist aber leider nicht so.

Die Erste kann ich auswählen (wie gewünscht)

Wenn ich das aber tue -> nimmt er dieselbe Datei auch als Zweite.

Somit habe ich schlussendlich die erste Datei mit ihr-selbst verglichen.

Bei dem aktuellen Makro werden die Dateien importiert, allerdings in "meine" Makro.XLSM
Die wird dann im Ablauf umbenannt in den Namen welcher von der ersten geöffneten Datei umbenannt,
z.B. in Trier.xlsx.
Beim Abspeichern werde ich dann noch darauf hingewiesen dass ein xlsx-Format keine Makro's abspeichern kann. Logisch.
Kann man irgendwo: Open-, oder Import in NewWorksheet einbringen ?

Vielen Dank

mfg

[Kuwer]

Hallo Paul,

ungetestet:

Option Explicit



Sub ELTEK_Compare()

' Created 06.04.2016

'

' ELTEK_Compare Macro

'

' Keyboard Shortcut: Ctrl+e

'

 Dim lngSheetsInNewWorkbook As Long

 Dim strDatei(0 To 2) As String

 Dim strName As String

 Dim strPfad As String

 'Pfad festlegen

 strPfad = "C:\ELTEK-Compare\"

 'Laufwerk und Pfad zum Öffnen vorgeben

 ChDrive strPfad

 ChDir strPfad

 

 'Datei-Öffnen-Dialog aufrufen

 strDatei(1) = Application.GetImportFilename("XML-Dateien (*.XML),*.xml")

 If Not CVar(strDatei(1)) = False Then

   'Letztes \ ermitteln um Pfad und Dateiname zu trennen

   strName = Mid(strDatei(1), Len(strPfad) + 1)

   'Letzten . ermitteln um Dateiname und Erweiterung zu trennen

   strName = Left(strName, InStrRev(strName, ".") - 1)

   'Datei-Öffnen-Dialog aufrufen

   strDatei(2) = Application.GetImportFilename("XML-Dateien (*.XML),*.xml")

   If Not CVar(strDatei(2)) = False Then

     lngSheetsInNewWorkbook = Application.SheetsInNewWorkbook

     Application.SheetsInNewWorkbook = 2

     With Workbooks.Add(xlWBATWorksheet)

       Application.SheetsInNewWorkbook = lngSheetsInNewWorkbook

       .Sheets(1).Name = "site1"

       .XmlImport URL:=strDatei(1), ImportMap:=Nothing, Overwrite:=True, Destination:=.Sheets(1).Range("$A$1")

       .Sheets(1).Columns("A:F").Delete

       .XmlImport URL:=strDatei(2), ImportMap:=Nothing, Overwrite:=True, Destination:=.Sheets(2).Range("$A$1")

       With .Sheets(2)

         .Name = "site2"

         .Columns("A:F").Delete

         With .Cells.FormatConditions.Add(Type:=xlExpression, Formula1:="=A1<>site1!A1")

           .SetFirstPriority

           .StopIfTrue = False

           With .Interior

             .PatternColorIndex = xlAutomatic

             .Color = 65535

             .TintAndShade = 0

           End With

         End With

       End With

 

       'Speichern-unter Dialog aufrufen

       strDatei(0) = Application.GetSaveAsFilename(InitialFileName:=strPfad & strName & ".xlsx", fileFilter:="Excel-Arbeitsmappe, *.xlsx")

       'falls Abbrechen gedrückt wird, Makro verlassen

       If CVar(strDatei(0)) = False Then

         'Meldung Makroabbruch

         MsgBox "Workbook not saved!", 48, "Abort by user"

       Else

         'aktive Arbeitsmappe speichern

         .SaveAs Filename:=strDatei(0), FileFormat:=51

       End If

     End With

   End If

 End If

End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß Uwe