in einem festgelegten Verzeichnis sollen alle xls-Dateien überprüft werden (alle gleich aufgebaut) ob sie Kriterien entsprechen, wenn nicht sollen sie in ein Unterverzeichnis dieses Verzeichnisses verschoben werden.
So wie es sich mir darstellt, funktioniert die Erstellung des Unterverzeichnisse "Schlecht" gut, auch die Überprüfung der Kriterien scheint gut zu klappen.
Mein Problem ist diese Zeile
.FoundFiles(F).Move Pfad & "\Schlecht\" & Dateiname
die mag der Debugger nicht :-( Fehler 424, Objekt erforderich
.FoundFiles(F) hat zu diesem Zeitpunkt den Inhalt: H:\kwMessdaten\abc..xls
Pfad hat zu diesem Zeitpunkt den Inhalt: H:\kwMessdaten
Dateiname hat zu diesem Zeitpunkt den Inhalt: abc.xls
Irgendwie benutze ich "Move" falsch, hab auch schon einiges ausprobiert, naja ergebnislos. Und ja, die Vba-Hilfe zu Move habe ich mir angeschaut, vielleicht habe ich da an Irgendwas wichtigem vorbeigeschielt *gg*
Hier der Code:
Option Explicit
Sub SpreuUndWeizen()
Dim fs, F, Pfad, Dateiname
Pfad = "H:\kwMessDaten"
If Dir(Pfad & "\Schlecht/nul") = "" Then MkDir Pfad & "\Schlecht"
Set fs = Application.FileSearch
With fs
.LookIn = Pfad
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For F = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(F)
Dateiname = ActiveWorkbook.Name
If Gut(ActiveWorkbook.Worksheets(1)) = False Then
ActiveWorkbook.Close savechanges:=False
MsgBox .FoundFiles(F)
.FoundFiles(F).Move Pfad & "\Schlecht\" & Dateiname
Else
ActiveWorkbook.Close savechanges:=False
End If
Next F
End If
End With
End Sub
Function Gut(Blatt As Worksheet) As Boolean
Dim Zähler As Byte, Zei As Long
For Zei = 7 To 35 Step 2
If Blatt.Cells(Zei, 2) >= Blatt.Cells(3, 2) Then
If Blatt.Cells(Zei, 2)
Danke ^ Gruß
Reinhard