AW: Experten! Range aus geschlossener Mappe auslesen?
28.01.2005 16:09:50
Bernd
Ich verwende sowas auch, du musst es dir nur noch anpassen da bei mir complett
Spalte A ausgelesen wird.
Sub Spalte_A_Auslesen()
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 = Range("B1").Value
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'!"
sTmp = Right(sFormula, Len(sFormula) - 1)
sFormula = sFormula & "A1"
rng.Offset(0, 1).Formula = sFormula
rng.Offset(0, 2).Formula = "=counta(" & sTmp & "A:A)"
iRow = rng.Offset(0, 2).Value
If iRow > 0 Then
rng.Offset(0, 2).Formula = "=" & sTmp & "A" & iRow
Else
rng.Offset(0, 2).ClearContents
End If
End If
Next iCounter
With Worksheets("Import").Range("A1").CurrentRegion
.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