VBA:Dateien öffnen; Laufzeitfehler 1004
06.12.2004 17:37:55
Michael
ich versuche mehrere Excel-Dateien in einer Tabelle zusammenzuführen ... Zu dieser Aufgabe findet sich auf dieser Seite hier schnell der Lösungsvorschlag 092200 ... (Suchworte: Dateien zusammenführen)
Originaldatei von der Herber-CD: https://www.herber.de/bbs/user/14407.xls (benötigt ein oder mehrere Dateien der Art Test1.xls, Test2.xls mit Einträgen in mehr als 6 Zeilen im gleichen Verzeichnis) .... Bsp: https://www.herber.de/bbs/user/14408.xls
Problem: Beim Start gibt es den Fehler:
"Laufzeitfehler 1004, 'Test1.xls' konnte nicht gefunden werden, ..."
Woran liegt es? Die Datei befindet sich definitv im Verzeichnis ... Wenn ich die Datei mit dem VBA Code direkt von der Herber-CD starte, funktioniert es. Speichere ich die Datei aber nur ein einziges Mal ab, gibt es beim nächsten Versuch den oben genannten Fehler ...
Hier noch das VBA-Coding:
Sub Zusammenfuehren()
Dim wksTarget As Worksheet
Dim arr As Variant
Dim iCounter As Integer, iRowS As Integer, iRowT As Integer
Dim sPath As String, sPattern As String
Application.ScreenUpdating = False
Workbooks.Add
Set wksTarget = Worksheets(1)
Range("A1") = "Datenimport"
Range("A1").Font.Bold = True
sPath = ThisWorkbook.Path
sPattern = "Test*.xls"
arr = arrAll(sPath, sPattern)
For iCounter = 1 To UBound(arr)
Workbooks.Open arr(iCounter)
iRowS = Cells(Rows.Count, 3).End(xlUp).Row
iRowT = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 2
With wksTarget.Cells(iRowT, 1)
.Value = arr(iCounter) & ":"
.Font.Bold = True
End With
iRowT = iRowT + 2
Rows("7:" & iRowS).Copy wksTarget.Cells(iRowT, 1)
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
Next iCounter
Columns.AutoFit
End Sub
Function arrAll(sPath As String, sPattern As String) As Variant
Dim arr()
Dim iCounter As Integer
Dim sFile As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & sPattern)
Do While sFile <> ""
iCounter = iCounter + 1
ReDim Preserve arr(1 To iCounter)
arr(iCounter) = sFile
sFile = Dir()
Loop
arrAll = arr
End Function
Viele Grüße,
Michael Böttcher