txt Dateien in Excel importieren

Sub OpenWkb1()
' Öffnet alle Dateien in einem angegebenen Verzeichnis mit der vorgegeben Endung
' Hier: Verzeichnis E:\Temp; Dateityp: *.txt
Dim sfile As String, sPath As String
' Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False
sPath = "F:\Hermilindis\jrn\jr16 - Kopie\"
' Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(sPath, 1)  "\" Then
sPath = sPath & "\"
End If
' Einlesen der Vorgaben in Variable
sfile = Dir(sPath & "*.txt")
' Schleife, die solange arbeitet, bis die letzte Fundstelle erreich wird und die Variable leer  _
bleibt
Do While sfile  ""
' Aufruf der weiteren Prozedur mit der Übergabe Verzeichisn und Name
Call TextImport1(sPath, sfile)
' Einlesen des nächsten Namens
sfile = Dir()
Loop
' Einschalten der Bildschirmaktualisierung
Application.ScreenUpdating = True
End Sub

Sub TextImport1(sPath As String, sfile As String)
Dim strVerzeichnis As String
Dim wkb As Workbook
' Speicherverzeichnis festlegen
strVerzeichnis = "F:\Hermilindis\jrn\jr16 - Kopie\"
' Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(strVerzeichnis, 1)  "\" Then
strVerzeichnis = strVerzeichnis & "\"
End If
' Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False
' Neue Mappe anlegen mit der vorgegebenen Anzahl Zabellen
Set wkb = Workbooks.Add
' Einlesen der Datei
Workbooks.OpenText Filename:=sPath & sfile, Tab:=False, Space:=True, _
Comma:=False, semicolon:=False, other:=False
' Speichern der Mappe
' Systemmeldung ausschalten
'Application.DisplayAlerts = False   ' Schaltet die Systemmeldung aus
wkb.SaveAs Filename:=strVerzeichnis & sfile & ".xls"
'Application.DisplayAlerts = True    ' Schaltet die Systemmeldung ein
' Schließen der beiden Dateien
wkb.Close
Workbooks(sfile).Close
Application.ScreenUpdating = True
End Sub