AW: gleiche Zelle im mehreren Mappen änden
19.03.2007 09:11:00
Hans
Hallo Holger,
folgender Code, wenn die 12 Monatsordner existieren und sich in den Ordnern ausschlisslich die zu ändernden Dateien befinden:
Sub EditWkbs()
Dim arr As Variant
Dim sBasis As String, sFolder As String, sFile As String
Dim iMonth As Integer, iFile As Integer
Application.ScreenUpdating = False
sBasis = "c:\temp\2007\"
For iMonth = 1 To 12
sFolder = Format(DateSerial(1, iMonth, 1), "mmmm") & "\"
arr = FileArray(sBasis & sFolder, "*.xls")
For iFile = 1 To UBound(arr)
If arr(1) False Then
Workbooks.Open sBasis & sFolder & arr(iFile), False
'Tue dies und das
ActiveWorkbook.Close savechanges:=True
End If
Next iFile
Next iMonth
Application.ScreenUpdating = True
End Sub
Function FileArray(strPath As String, strPattern As String)
Dim arrDateien()
Dim intCounter As Integer
Dim strDatei As String
If Right(strPath, 1) "\" Then strPath = strPath & "\"
strDatei = Dir(strPath & strPattern)
Do While strDatei ""
intCounter = intCounter + 1
ReDim Preserve arrDateien(1 To intCounter)
arrDateien(intCounter) = strDatei
strDatei = Dir()
Loop
If intCounter = 0 Then
ReDim arrDateien(1)
arrDateien(1) = False
End If
FileArray = arrDateien
End Function
Gruss hans