AW: Ordner durchsuchen und richtiges XLS öffnen
16.11.2009 15:59:12
JogyB
Hi.
Das ist ein zugriff auf alte Excel4 Makros. Das ist nirgends mehr dokumentiert, funktioniert aber noch. Damit gehen einige schöne Dinge, die Excel nicht mehr kann, so z.B. der Zugriff auf geschlossene Dateien.
In der Klammer von ExecuteExcel4Macro muss folgendes stehen, wenn die Datei z.B. abcef_20091113.xls heißt:
MAX('c:\Temp\test\[abcef_20091113.xls]abcef_20091113'!C4:C4)
C4 ist in der Tat Spalte 4, das Ausrufezeichen ist doch eigentlich auch logisch, das ist die ganz normale Syntax für einen Bezug auf eine andere Datei (nur in Z1S1-Schreibweise und auf englisch).
Die Alternative wäre jetzt natürlich, jede Datei aufzumachen. Sähe dann so aus:
Sub Datum_checken2()
Dim i As Long
Dim dateiNum As String
Dim myDatei As String
Dim fileDate As Date
Dim maxDate As Date
Dim testDatei As Workbook
Const myPath = "c:\Temp\test\"
' In Frage kommende Dateien zählen - wird als Abbruchkriterium benötigt
' Wenn es keine gibt, dann gleich raus
If Dir(myPath & "*_*.xls") = "" Then
Call MsgBox("Keine Dateien gefunden!", vbCritical)
Exit Sub
Else
dateiNum = 1
End If
' Dateien mit richtigem Format zählen
Do
myDatei = Dir
If myDatei Like "*_########.xls" Then
dateiNum = dateiNum + 1
End If
Loop Until myDatei = ""
Application.ScreenUpdating = False
' Jetzt die Datei suchen, in der ein Datum von letztem Monat vorkommt
Do
fileDate = DateSerial(Year(Date), Month(Date), Day(Date) - i)
' Habe das hier mit einem variablen Dateibeginn gemacht
' Bei fixem Beginn ersetzt Du myPath durch das "abcdef" (mit Anführungszeichen)
myDatei = Dir(myPath & "*_" & _
Format(DateSerial(Year(Date), Month(Date), Day(Date) - i), "yyyymmdd") & ".xls")
If myDatei "" Then
' Datei schreibgeschützt öffnen (minimiert mögliche Fehler)
Set testDatei = Workbooks.Open(myPath & myDatei, , True)
' Überprüfen, ob Öffnen geklappt hat
If testDatei Is Nothing Then
Call MsgBox("Konnte Datei '" & myDatei & "' nicht öffnen!" & vbNewLine & _
"Vorgang wird abgebrochen.", vbCritical)
Application.ScreenUpdating = True
Exit Sub
End If
' höchstes Datum auslesen
maxDate = _
Application.Max(testDatei.Sheets(Left(myDatei, Len(myDatei) - 4)).Columns(4))
' Wenn Datum aus letztem Monat, dann Schreibzugriff + raus
If DateSerial(Year(Date), Month(Date) - 1, 1) = _
DateSerial(Year(maxDate), Month(maxDate), 1) Then
testDatei.ChangeFileAccess xlReadWrite
Exit Do
Else
i = i + 1
' Datei wieder zu
testDatei.Close False
Set testDatei = Nothing
End If
End If
Loop Until i = dateiNum
' Wenn i hier auf Dateinum steht, dann wurde nichts gefunden
If i = dateiNum Then
Call MsgBox("Keine Datum aus letztem Monat gefunden!", vbCritical)
End If
Application.ScreenUpdating = True
End Sub
Das fängt jetzt nicht ab, ob die Datei schon offen ist.
Gruss, Jogy