ich will mehrere Textdateien per VBA einlesen, bearbeiten und dann als
Excel Datei abspeichern (13 Ordner a 140 Dateien).
Dazu habe ich mir ein Makro gemacht, was alles wie gewünscht ausführt
- nur leider bricht das Programm immer mal wieder mit der folgenden
Fehlermeldung ab:
1004 Laufzeitfehler
kann keine weiteren Dateien öffnen oder speichern, da nicht genügend
Speicher oder Festplattenplatz vorhanden ist...
Was kann ich da machen?
Das Makro habe ich unten gekürzt angehangen.
Es bricht immer beim Workbooks.OpenText ... ab.
Vielen Dank für die Hilfe.
reep
Makro:
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