Excel-Import von CAMT.054.xml Dateien

Option Explicit
 Dim verz As String
  
 Sub kontoAuszugLaden()
 Dim pfad As String, datei As String, bName As String, ext As String
 Dim ret As Long
 Dim inhalt As String
 Dim p As Long
  
 ' Es wird erfragt, welche Datei eingelesen werden soll:
 With Application.FileDialog(msoFileDialogOpen)
 If verz <> "" Then .InitialFileName = verz
 .Filters.Add "Konto-Dateien", "*.xml"
 .InitialView = msoFileDialogViewDetails
 .Title = "Konto-Datei wählen"
 If .Show <> -1 Then Exit Sub
 pfad = .SelectedItems(1)
 End With
  
 ' Aus dem kopletten Pfad werden das Verzeichnis, der Dateiname, und die Eweiterung extrahiert:
 verz = Left(pfad, InStrRev(pfad, "\"))
 datei = Mid(pfad, Len(verz) + 1)
 bName = Left(datei, InStrRev(datei, ".") - 1)
 ext = Mid(datei, InStrRev(datei, ".") + 1)
  
 ' Die komplette Datei wird in die Variable "inhalt" gelesen:
 inhalt = komplettEinlesen(pfad)
  
 ' Wenn der Ausdruck "<Ref>" in der Datei nicht vorkommt, ist es eine falsche Datei:
 p = InStr(inhalt, "<Ref>")
 If p = 0 Then
 MsgBox "Der Datei-Inhalt entspricht nicht dem Konto-Dateiformat", , "Geht nicht!"
 Exit Sub
 End If
  
 ' Zwischen die erste und die zweite Ziffer der Referenznummer wird ein nicht druckbares Zeichen (TAB) eingefügt:
 inhalt = Left(inhalt, p + 5) & Chr(9) & Mid(inhalt, p + 6)
  
 ' Der komplette Datei-Inhalt (Variable "inhalt") wird in eine Datei geschrieben.
 ' Diese Datei steht im selben Verzeichnis wie die Ursprungs-Datei.
 ' Sie bekommt den selben Grundnamen wie die Urpsrungsdatei, mit angehängten "_2".
 komplettSchreiben verz & bName & "_2." & ext, inhalt
  
 ' Die neue Datei wird als XML-Datei geöffnet:
 Workbooks.OpenXML Filename:= _
 verz & bName & "_2." & ext, LoadOption:=xlXmlLoadImportToList
 Range("A:A,E:E").NumberFormat = "0"
 End Sub
  
 ' Einlesen einer kompletten Datei in eine Text-Variable:
 Function komplettEinlesen(datei As String) As String
 Dim FF As Long
   
 ' Freie Filenummer erfragen:
 FF = FreeFile
   
 ' Die Textvariable wird vorbereitet: Sie wird in der länge der Datei mit Leerzeichen gefüllt:
 komplettEinlesen = Space(FileLen(datei))
  
 ' Die Datei wird geöffnet, komplett in die Variable eingelesen und wieder geschlossen:
 Open datei For Binary As #FF
 Get #FF, , komplettEinlesen
 Close #FF
 End Function
  
 ' Schreiben einer Textvariablen als komplette Datei:
 Sub komplettSchreiben(datei As String, inhalt As String)
 Dim FF As Long
  
 ' Freie Filenummer erfragen:
 FF = FreeFile
  
 ' Die Datei wird geöffnet, mit der Textvariablen beschrieben und wieder geschlossen:
 Open datei For Binary As #FF
 Put #FF, , inhalt
 Close #FF
 End Sub