AW: Daten aus geschlossenen Arbeitsmappen auslesen
02.06.2004 16:03:30
andre
Hallo Patrick,
probiers mal so. In Spalte A Deiner Zieltabelle wird der Name der Datenquelle eingetragen.
Sub DateienAuslesen()
Dim rng As Range
Dim arr As Variant
Dim iCounter As Integer, iRow As Integer, iAct As Integer
Dim sPath As String, sFormula As String, sTmp As String
Application.ScreenUpdating = False
sPath = "C:\test" 'hier gegen Dein Verzeichnis tauschen, z.B. "C:\April",
arr = FileArray(sPath, "*.xls")
For iCounter = 1 To UBound(arr)
If FileDateTime(sPath & arr(iCounter)) <= Date + 1 Then
With Worksheets("Import")
If IsEmpty(.Cells(1, 1)) Then
Set rng = .Range("A1")
Else
Set rng = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
End With
rng.Value = sPath & arr(iCounter)
sFormula = "='"
sFormula = sFormula & sPath & "["
sFormula = sFormula & arr(iCounter) & "]"
sFormula = sFormula & "Tabelle1'!" 'hier Tabellenname der Quelldatei
For i = 1 To 10 'A=1 bis J=10
sFormulatmp = sFormula & Spalte(i) & "3"
rng.Offset(0, i).Formula = sFormulatmp
Next
End If
Next iCounter
With Worksheets("Import").Range("A1").CurrentRegion
' hier statt "Import" Deine Zieltabelle eintragen
.Value = .Value
End With
End Sub
Function FileArray(sPath As String, sPattern As String)
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
FileArray = arr
End Function
Function Spalte(ByVal Spaltennummer As Integer) As String
'für Spalte A bis IV
Spalte = Cells(Spaltennummer).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Spalte = Left(Spalte, Len(Spalte) - 1)
End Function