AW: Verzeichnisse durchsuchen - Dateien ändern
01.12.2006 11:31:46
haw
Hallo Doc
hier noch eine andere Möglichkeit und die fehlende Funktion zur Ordnerauswahl
Sub Listen()
Dim sSource$, iCount%, iCounter%
Dim wks As Worksheet
'Startverzeichnis wählen
sSource = VerzeichnisWählen()
ChDrive Left(sSource, 1)
ChDir sSource
With Application.FileSearch
.NewSearch
.LookIn = sSource
.Filename = "*.xls"
.SearchSubFolders = True
.Execute
iCount = .FoundFiles.Count
For iCounter = 1 To iCount
Workbooks.Open Filename:=.FoundFiles(iCounter)
Set wb = ActiveWorkbook
wb.Worksheets(1).Range("A1").Value = "erledigt"
Next iCounter
End With
End Sub
Public
Function VerzeichnisWählen() As String
Dim Ret As Long
Dim Browse As BROWSEINFO
Dim Liste As Long
Dim Pfad As String, wPos As Integer
Browse.lpszTitle = "Bitte ein Startverzeichnis wählen"
Browse.ulFlags = BIF_RETURNONLYFSDIRS
Liste = SHBrowseForFolder(Browse)
Pfad = String(1024, 0)
Ret = SHGetPathFromIDList(ByVal Liste, ByVal Pfad)
If Ret Then
VerzeichnisWählen = NullTrimmen(Pfad)
End If
End Function
Gruß
Heinz