Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
624to628
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
624to628
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dateisuche

Dateisuche
16.06.2005 06:37:06
Detlef
Guten Morgen zusammen,
ich habe folgendes Problem bei dem ich nicht weiter komme:
Ich suche Exceldateien die alle den gleichen Namen haben (der mir bekannt ist), sich aber in unterschiedlichen Verzeichnissen befinden. Das Programm soll also alle Ordner und Unterordner auf einem bestimmten Laufwerk durchsuchen und den Verzeichnisspfad der gefundenen Datei in einer Exceltabelle ausgeben.
Ich bin für jede Hilfe dankbar...
Gruß,
Detlef

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateisuche
16.06.2005 06:59:25
chris
Hallo Detlef hier habe ich was für dich ! Auch mal aus dem Forum bekommen !
Hoffe es hilft dir !!
grüße Christian

Sub List_Files_in_all_folder2()
' jedes Unterverzeichnis in eine Spalte
' ergänzt
Dim Dateiform As String
Dim Verzeichnis As String
Dim J As Integer
Dim K As Long
Dim Bereich As Range
Dim Dateiname As String
J = 1: K = 2
Dim I As Long, TotFiles As Long
Dim gefFile As String, dname As String
Dim Suchpfad As String, suchbegriff As String
Dim OldStatus As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
OldStatus = Application.StatusBar
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = True
' .SearchSubFolders = False
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For I = 1 To .FoundFiles.Count
' ergänzt für Unterverzeichnis
' festellen aller Unterverzeichnisse und in Zeile 1 schreiben
Dim L As Integer
For L = Len(.FoundFiles(I)) To 1 Step -1
If Mid(.FoundFiles(I), L, 1) = "\" Then Exit For
Next L
If Verzeichnis = "" Then
Verzeichnis = Mid(.FoundFiles(I), 1, L)
Else
If Mid(.FoundFiles(I), 1, L) <> Verzeichnis Then
Verzeichnis = Mid(.FoundFiles(I), 1, L)
K = 2
End If
End If
Set Bereich = ActiveSheet.Range("A1:IV256").Find(Mid(.FoundFiles(I), 1, L), lookat:=xlWhole)
If Bereich Is Nothing Then
Cells(1, J) = Mid(.FoundFiles(I), 1, L)
J = J + 1
End If
Next I
' Dateienfeststellen
For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
Dateiname = Dir(Cells(1, I) & Dateiform)
Do While Dateiname <> ""
Cells(Cells(Rows.Count, I).End(xlUp).Row + 1, I).Value = Dateiname
K = K + 1
Dateiname = Dir
Loop
Next I
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Dateisuche
16.06.2005 08:52:03
Detlef
Hallo Chris,
genau das wars.
Vielen Dank, super hilfe....
AW: Dateisuche
16.06.2005 07:25:16
GraFri
Hallo
Vielleicht hilft dir folgender Code weiter. Ausgabe zur Zeit über Msgbox, kann aber geändert werden.


      
' ***********************************************************************************
' In ein Modul
' Quelle: http://www.vb-tec.de/fndfiles.htm
'
Option Explicit
Private Declare Sub FindClose Lib "kernel32" ( _
    
ByVal hFindFile As Long)
Private Declare Function FindFirstFileA Lib "kernel32" ( _
    
ByVal lpFileName As String, _
    lpFindFileData 
As WIN32_FIND_DATA _
  ) 
As Long
Private Declare Function FindNextFileA Lib "kernel32" ( _
    
ByVal hFindFile As Long, _
    lpFindFileData 
As WIN32_FIND_DATA _
  ) 
As Long
Private Declare Function GetFileAttributesA Lib "kernel32" ( _
    
ByVal lpFileName As String _
  ) 
As Long
Private Type FILETIME
  dwLowDateTime 
As Long
  dwHighDateTime 
As Long
End Type
Private Type WIN32_FIND_DATA
  dwFileAttributes 
As Long
  ftCreationTime 
As FILETIME
  ftLastAccessTime 
As FILETIME
  ftLastWriteTime 
As FILETIME
  nFileSizeHigh 
As Long
  nFileSizeLow 
As Long
  dwReserved0 
As Long
  dwReserved1 
As Long
  cFileName 
As String * 260
  cAlternate 
As String * 14
End Type
'------------------------------------------------------------------------------------

'Mit der unten stehenden Funktion FindFiles ist es möglich, einen Dateibaum
'gemäß eines Datei-Patterns (z.B. "*.txt") zu durchsuchen. Optional können
'erforderliche Datei-Attribute (s.a. GetAttr in der VBA-Hilfe) angegeben werden.
'Mit dem Recursive-Parameter kann definiert werden, ob alle Unter-Verzeichnisse
'ebenfalls durchsucht werden sollen (Voreinstellung), oder nicht.
'Zurückgegeben wird die Anzahl der gefundenen Dateien.

'Der Parameter Files enthält nach Funktions-Ausführung eine Collection aller
'gefundenen Dateien (mitsamt vollständigem Pfad). Die Funktion kann auch mehrmals
'hintereinander (mit unterschiedlichen Such-Parametern) aufgerufen werden;
'Dann werden alle neu gefundenen Dateien der Collection hinzugefügt.

Dim Dateien     As Collection
Dim i           As Long
Sub Dateisuche_starten()
'Löschen der Einträge, ansonsten wird bei einem erneuten Aufruf die neuen
'Suchergebnisse angehängt
Set Dateien = Nothing
'FindFiles "E:\Excel 2000\Beispiele", Dateien, "*.xls"
FindFiles "C:\", Dateien, "Mappe1.xls"
If Dateien.Count Then
  
For i = 1 To Dateien.Count
    MsgBox Dateien(i)
  
Next i
Else
  MsgBox "Nichts gefunden!"
End If
End Sub
'------------------------------------------------------------------------------------
' ***********************************************************************************
Public Function FindFiles( _
    
ByVal Path As String, _
    
ByRef Files As Collection, _
    
Optional ByVal Pattern As String = "*.*", _
    
Optional ByVal Attributes As VbFileAttribute = vbNormal, _
    
Optional ByVal Recursive As Boolean = True _
  ) 
As Long
  
  
Const vbErr_PathNotFound = 76
  
Const INVALID_VALUE = -1
  
  
Dim FileAttr      As Long
  
Dim FileName      As String
  
Dim hFind         As Long
  
Dim WFD           As WIN32_FIND_DATA
  
  
'Initialisierung:
  If Right$(Path, 1) <> "\" Then Path = Path & "\"
  
If Files Is Nothing Then Set Files = New Collection
  Pattern = LCase$(Pattern)
  
  
'Suche starten:
  hFind = FindFirstFileA(Path & "*", WFD)
  
If hFind = INVALID_VALUE Then Err.Raise vbErr_PathNotFound
  
  
'Suche fortsetzen:
  Do
    FileName = LeftB$(WFD.cFileName, InStrB(WFD.cFileName, vbNullChar))
    FileAttr = GetFileAttributesA(Path & FileName)
    
    
If FileAttr And vbDirectory Then
    
      
'Verzeichnis analysieren:
      If Recursive Then
        
If FileAttr <> INVALID_VALUE And FileName <> "." And FileName <> ".." Then
          FindFiles = FindFiles + FindFiles(Path & FileName, Files, Pattern, Attributes)
        
End If
      
End If
    
    
Else
    
      
'Datei analysieren:
      If (FileAttr And Attributes) = Attributes Then
        
If LCase$(FileName) Like Pattern Then
          FindFiles = FindFiles + 1
          Files.Add Path & FileName
        
End If
      
End If
    
    
End If
  
Loop While FindNextFileA(hFind, WFD)
  FindClose hFind
End Function
' ***********************************************************************************

 


Bei weiteren Fragen einfach melden.
mfg, GraFri
Anzeige
AW: Dateisuche
16.06.2005 08:53:44
Detlef
Hallo GraFri,
Danke schön für die schnelle hilfe. Mit dem Code muß mich erst mal beschäftigen.
Gruß,
Detlef

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige