Ordner suchen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Ordner suchen
von: Herbert
Geschrieben am: 09.04.2005 12:38:35
Hallo Leute,
Windows 98,Office 97
wie kann man feststellen, ob ein Ordner existiert, wenn man nicht weiß,
auf welchem Laufwerk er sich befindet? Mit Filesearch scheint das nicht
zu gehen, jedenfalls bekomme ich das nicht hin.
Bin für jede Hilfe dankbar.
Grüße Herbert(HH)

Bild

Betrifft: AW: Ordner suchen
von: Ramses
Geschrieben am: 09.04.2005 13:46:43
Hallo
mal so als Einstieg zum ausprobieren


Option Explicit
'Der gesuchte Folder muss in jedem Fall mit dem gesamten 
'Root-Verzeichnis angegeben werden
'Gesuchter Pfad:
'D:\Mustermann\Muster"
'Muss als Suchangabe
'\Mustermann\Muster
'angegeben werden
'Als Makro
Sub Found_Folder()
'(c) Ramses
Dim myFSO As Object, myDrv As Object, srchFld As Object
Dim findFld As String
findFld = "\Mustermann\Muster"
Set myFSO = CreateObject("Scripting.FileSystemObject")
For Each myDrv In myFSO.drives
     With myDrv
          Debug.Print .driveletter
          On Error Resume Next
          Set srchFld = myFSO.GetFolder(.driveletter & ":" & findFld)
          If Not srchFld Is Nothing Then
               MsgBox "Folder existiert auf Laufwerk: " & .driveletter
               Exit Sub
          End If
    End With
Next
End Sub
'Als Funktion zur Überprüfung aus einem anderen Makro heraus
Sub CheckFolder()
MsgBox Find_Folder("\Mustermann\Muster")
End Sub
Function Find_Folder(findFld As StringAs String
'(c) Ramses
Dim myFSO As Object, myDrv As Object, srchFld As Object
Set myFSO = CreateObject("Scripting.FileSystemObject")
For Each myDrv In myFSO.drives
     With myDrv
          On Error Resume Next
          Set srchFld = myFSO.GetFolder(.driveletter & ":" & findFld)
          If Not srchFld Is Nothing Then
               Find_Folder = .driveletter & ":" & findFld
               Exit Function
          End If
    End With
Next
End Function

     Code eingefügt mit Syntaxhighlighter 2.5

Gruss Rainer
Bild

Betrifft: AW: Ordner suchen
von: Herbert
Geschrieben am: 09.04.2005 14:02:09
Hallo Rainer,
ich kenne nur den Ordnernamen und weiß keinen Pfad, wie soll ich dein Beispiel
umsetzen? Kannst du nochmal erlären?
Grüße Herbert
Bild

Betrifft: AW: Ordner suchen
von: Ramses
Geschrieben am: 09.04.2005 14:06:44
Hallo
Dann vergiss es.
Wenn du nicht weisst wie der Pfad lautet, musst du jede einzelne Ordnerstruktur durchsuchen.
Das ist das gleiche, wenn du in einem Buch nach einem Wort suchst und nicht weisst wo es stehst. Da bleibt dir nichts anderes übrig als das ganze Buch zu lesen.
Weiss dein Benutzer wo der Ordner ist ?
Gruss Rainer
Bild

Betrifft: AW: Ordner suchen
von: Herbert
Geschrieben am: 09.04.2005 14:13:27
Hallo Rainer,
ich muss davon ausgehen, dass er es nicht weiß.
Schade, dass du mir nicht helfen kannst.
Nur komisch, nach Dateien kann man ja mit *.* suchen und im Explorer
werden da ja auch Ordner gefunden.
Grüße Herbert
Bild

Betrifft: vergessen, noch offen.
von: Herbert
Geschrieben am: 09.04.2005 14:18:30
offen
Bild

Betrifft: AW: Ordner suchen
von: Ramses
Geschrieben am: 09.04.2005 14:20:13
Hallo
"..nach Dateien kann man ja mit *.* ..."
Natürlich. Das kann man auch mit VBA
"...und im Explorer werden da ja auch Ordner gefunden...."
Natürlich, aber A) nur wenn man auf dem richtigen Laufwerk sucht, und dann darf nur ein einziger da sein.
Das ganze ist bloss ein Zeitproblem.
Bei einer 120 GB kann das schon dauern.
Gruss Rainer
Gruss Rainer
Bild

Betrifft: AW: Ordner suchen
von: Nepumuk
Geschrieben am: 09.04.2005 15:34:58
Hallo Hebert,
wozu gibt es API. Das folgende Makro dursucht sämtliche Laufwerke nach dem Ordner "Nepumuk" und gibt dir den Pfad in einer Msgbox aus. Das musst du dann auf deine Bedürfnisse anpassen.


Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
    (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As LongAs Long
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE  As Long = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
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 * MAX_PATH
    cAlternate As String * 14
End Type
Private bolFound As Boolean
Public Sub prcSearchFolder()
    Dim myFso As Object, myDrive As Object
    Set myFso = CreateObject("Scripting.FileSystemObject")
    For Each myDrive In myFso.Drives
        If myDrive.isready Then Call prcFindFolder(myDrive.DriveLetter & ":", "Nepumuk")
        If bolFound Then Exit For
    Next
    bolFound = False
    Set myFso = Nothing
End Sub
Private Sub prcFindFolder(ByVal strFolderPath As StringByVal strFoldername As String)
    Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String
    lngSearch = FindFirstFile(strFolderPath & "\*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
                strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
                If (strDirName <> ".") And (strDirName <> "..") Then
                    If strDirName = strFoldername Then
                        MsgBox strFolderPath
                        bolFound = True
                        Exit Do
                    Else
                        Call prcFindFolder(strFolderPath & "\" & strDirName, strFoldername)
                    End If
                End If
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub


Gruß
Nepumuk
Bild

Betrifft: AW: Ordner suchen
von: Herbert
Geschrieben am: 09.04.2005 16:02:32
Hallo Nepumuk,
keine Ahnung wie und warum, aber es funktioniert und geht sogar recht flott.
Danke und ein nettes Wochenende.
Grüße Herbert
Bild

Betrifft: P.S.....
von: Herbert
Geschrieben am: 09.04.2005 16:06:49
Ich wußte übrigens gar nicht, dass sich auf meinem Rechner 11 Ordner mit dem Namen
Nepumuk befinden.
Grüße Herbert
Bild

Betrifft: AW: Ordner suchen ohne API
von: Rolf Beißner
Geschrieben am: 09.04.2005 17:31:30
Hallo Nepumuk,
geht auch mit Bordmitteln - s.u.
hG
Rolf
'angepasstes Hilfebeispiel
'Aufgabe
'der PC (msoSearchInMyComputer) wird
'nach einem definierten Verzeichnis (const foldspec)
'nach den definierten Dateitypen (msoFileType) durchsucht
Option Explicit

Sub SearchEveryFolder()
    On Error Resume Next
    Dim ss As SearchScope
    Dim sf As ScopeFolder
    Dim lngCount As Long
    
    Const foldspec = "MyFolder"
    
    Call collect_delete
    
    With Application.filesearch
        .NewSearch
        .FileType = msoFileTypeExcelWorkbooks
        For Each ss In .SearchScopes
            Select Case ss.Type
                Case msoSearchInMyComputer
                    For Each sf In ss.ScopeFolder.ScopeFolders
                        Call OutputPaths(sf.ScopeFolders, foldspec)
                    Next sf
                Case Else
            End Select
        Next ss
        If .SearchFolders.Count > 0 Then
            .LookIn = .SearchFolders.Item(1).Path
            If .Execute <> 0 Then
                MsgBox "Files found: " & .FoundFiles.Count
                Sheets.Add
                For lngCount = 1 To .FoundFiles.Count
                    Cells(lngCount, 1) = .FoundFiles.Item(lngCount)
                Next lngCount
            End If
        End If
    End With
End Sub

'Altsuche löschen

Sub collect_delete()
    Dim lngCount As Integer
    With Application.filesearch
        For lngCount = .SearchFolders.Count To 1 Step -1
            .SearchFolders.Remove lngCount
        Next lngCount
    End With
End Sub


Sub OutputPaths(ByVal sfs As ScopeFolders, _
    ByRef strFolder As String)
    Dim sf As ScopeFolder
    For Each sf In sfs
        If LCase(sf.Name) = LCase(strFolder) Then
            sf.AddToSearchFolders
        End If
        DoEvents
        If sf.ScopeFolders.Count > 0 Then
            Call OutputPaths(sf.ScopeFolders, strFolder)'rekursiv!!!
        End If
    Next sf
End Sub

Bild

Betrifft: AW: Ordner suchen ohne API
von: K.Rola
Geschrieben am: 09.04.2005 17:41:19
Hallo,
wirf mal einen Blick auf Herberts Office-Version.
Gruß K.Rola
Bild

Betrifft: AW: Ordner suchen ohne API
von: Rolf Beißner
Geschrieben am: 09.04.2005 17:56:11
Si, si, Signora,
war auch mehr für N. gedacht.
Herzliche Grüße
Rolf
Bild

Betrifft: AW: Ordner suchen
von: Reinhard
Geschrieben am: 09.04.2005 15:27:16
Hallo Herbert,
lass ne Dos-Batch mit nachfolgendem Inhalt laufen, danach kannst du die Datei test.txt mit Excel auswerten. "Hr3" ist der gesuchte Ordnername.
Gruß
Reinhard

@echo off
dir c:\ /b/-p/s/A:d | find /i "Hr3" >c:\test.txt
dir d:\ /b/-p/s/A:d | find /i "Hr3" >>c:\test.txt
dir e:\ /b/-p/s/A:d | find /i "Hr3" >>c:\test.txt
dir f:\ /b/-p/s/A:d | find /i "Hr3" >>c:\test.txt

Bild

Betrifft: AW: Ordner suchen
von: Herbert
Geschrieben am: 09.04.2005 16:04:37
Hallo Reinhard,
sicher gut gemeint aber damit kann ich gar nichts anfangen.
Die Lösung von Nepumuk funktioniert einwandfrei.
Grüße Herbert
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Ordner suchen"