Laufzeitfehler 1004 beim Einlesen von Dateien

Public Sub EinlesenTxtDateien()
Application.ScreenUpdating = False
Dim wkb As Workbook
Dim wks As Worksheet
Dim TmpDat As Variant
Dim strDirectory, strDirSpeichern, strWb, strOrt1, strSpeichern, strWord As String
Dim i, ende, sp1 As Long
Dim rng As Range
For sp1 = 1 To 13
If sp1 = 1 Then
strDirectory = "D:\test1\txt\"
strDirSpeichern = "D:\test1\xls\"
End If
'Hier kommen dann noch die if-Abfragen für die restlichen 12 Ordner
'In TmpDat werden die Verzeichnisnamen abgespeichert
TmpDat = Dir(strDirectory & "*.txt")
' Alle Worksbooks mit dem Namen in TmpDat öffnen
Do While (TmpDat)  ""
strWb = TmpDat
strOrt1 = strDirectory + strWb
Workbooks.OpenText Filename:=strOrt1, _
DataType:=xlDelimited, Tab:=True
Set wkb = ActiveWorkbook
Set wks = wkb.Worksheets(1)
If InStr(1, Left(strWb, Len(strWb) - 4), "kor")  0 Then
wks.Rows(2).Delete
wks.Range("B2").Select
ActiveWindow.FreezePanes = True
End If
'Hier werden noch weitere Dinge am Sheet geändert - habe ich rausgenommen
wks.UsedRange.Columns.AutoFit
'wks.Name = Left(strWb, Len(strWb) - 4)
strSpeichern = strDirSpeichern + Left(strWb, Len(strWb) - 4)
wkb.SaveAs Filename:=strSpeichern, FileFormat:=xlWorkbookNormal
wkb.Close
Set wkb = Nothing
TmpDat = Dir()
Loop
Next
Application.ScreenUpdating = True
End Sub