Anzeige
Archiv - Navigation
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
804to808
804to808
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Unterordner mit einbeziehen

Unterordner mit einbeziehen
28.09.2006 10:09:51
volker
Hai Excels,
im folgenden Code werden Dateien eines Ordners (.LookIn = Range("D1").Value
) geöffnet gecheckt wieder geschlossen....
Ist es möglich den Code so zu ändern, dass auch Unterordner mit einbezogen werden?
Danke Gruss volker

Sub BlätterLöschen()
'Dateien öffnen
Dim wks As Worksheet
Dim fs As FileSearch
Dim lRow As Long
Dim iCounter As Integer
'Application.ScreenUpdating= false
Application.DisplayAlerts = False
Set fs = Application.FileSearch
lRow = 3
'lRow = InputBox("Zeilen Nr. angeben")
With fs
.Filename = "*.xls"
.LookIn = Range("D1").Value
.Execute
For iCounter = 1 To .FoundFiles.Count
'Cells(lRow, 1).Value = .FoundFiles(iCounter)
If VBA.FileDateTime(.FoundFiles(iCounter)) < Now - 14 Then
lRow = lRow
Workbooks.Open .FoundFiles(iCounter)
'unbeschriebene Beschlaglisten löschen
For Each wks In ActiveWorkbook.Worksheets
With wks
Select Case .Name
Case "Holzliste", "Zeiten", "Laufkarte"
'do nothing
Case "BL Container"
If Application.WorksheetFunction.CountA(.Range("A7:A32")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Conside"
If Application.WorksheetFunction.CountA(.Range("A7:A15"), .Range("A38"), .Range("A40:A60")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Depona"
If Application.WorksheetFunction.CountA(.Range("A7:A15"), .Range("A40:A60")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL K4"
If Application.WorksheetFunction.CountA(.Range("A7:A17"), .Range("A21:A31"), .Range("A38:A40"), .Range("A46:A62")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Kabinentrennwand"
If Application.WorksheetFunction.CountA(.Range("A7:A18"), .Range("A21:A26")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL ComWagen"
If Application.WorksheetFunction.CountA(.Range("A8:A31"), .Range("A39:A62")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case Else
If Application.WorksheetFunction.CountA(.Range("A7:A31"), .Range("A39:A64")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
End Select
End With
Next wks
ActiveWorkbook.Close savechanges:=True
'Application.Wait Now + 5 / 86400
End If
Next iCounter
End With
'Application.ScreenUpdating=True
Application.DisplayAlerts = True
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Unterordner mit einbeziehen
28.09.2006 10:21:27
Heiko
Hallo Volker,
z.B. so:
With fs
.SearchSubFolders = True
.Filename = "*.xls"
.LookIn = Range("D1").Value
.Execute
Gruß Heiko
PS: Rückmeldung wäre nett !
Des geht!! und wie!! Super, Danke
28.09.2006 14:34:38
volker
Gruss volker
Anzeige

183 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige