Tipp 1.5 - Datei suchen

Wie kann ich eine Datei auf einem Laufwerk suchen?

Mit dieser Funktion können Sie eine Datei auf einem Laufwerk suchen. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Api-AufrufeVerwendete Win32-Api-Aufrufe und Typen: SearchTreeForFile, FormatMessage

Beispiel:

Option Explicit
 
Public Declare Function SearchTreeForFile Lib _
    "imagehlp.dll" _
    (ByVal sRootPath As String, _
    ByVal InputPathName As String, _
    ByVal OutputPathBuffer As String) _
    As Boolean
Public Declare Function FormatMessage Lib _
    "kernel32" Alias _
    "FormatMessageA" _
    (ByVal dwFlags As Long, _
    lpSource As Any, _
    ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, _
    ByVal lpBuffer As String, _
    ByVal nSize As Long, _
    Arguments As Long) As Long
 
Public Function SearchDriveForFile( _
                ByVal sScanDrive As String, _
                ByRef sFileName As String, _
                Optional ByRef sError _
                As String = vbNullString) _
                As String
  '// -----------------------------------------------------
  '// Methode:   | Durchsucht ein Laufwerk nach einer Datei
  '// -----------------------------------------------------
  '// Parameter: | sScanDrive = Suchlaufwerk
  '//            | sFilename = Name der gesuchten Datei
  '// -----------------------------------------------------
  '// Rückgabe:  | kompletter Dateipfad,
  '//            | falls gefunden (1. Treffer)
  '//            | optional: Beschreibung im Fehlerfall
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
 
  Dim sResult     As String
  Dim lResult     As Long
  Dim lErrCode    As Long
  If VBA.Len(sScanDrive) > 0 Then
    sScanDrive = VBA.Left(sScanDrive, 1) & ":"
    sResult = VBA.String(260, 0)
    lResult = SearchTreeForFile(sScanDrive, _
                                sFileName, _
                                sResult)
    lErrCode = Err.LastDllError
    If lResult Then
      SearchDriveForFile = _
          VBA.Left(sResult, VBA.InStr(sResult, _
                                      vbNullChar) - 1)
    Else: sError = GetDllErrorDescription(lErrCode)
    End If
  End If
 
End Function
 
Public Function GetDllErrorDescription( _
                ByVal lErrCode As Long) _
                As String
  '// -----------------------------------------------------
  '// Methode:   | Ermittelt die Beschreibung eines
  '//            | API-Fehlers
  '// -----------------------------------------------------
  '// Parameter: | lErrCode = API-Fehlernummer
  '// -----------------------------------------------------
  '// Rückgabe:  | Beschreibung des API-Fehlers
  '// -----------------------------------------------------
  Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
  Dim lMsgSize    As Long
  Dim sSysMsg     As String
  If lErrCode <> 0 Then
    lMsgSize = 1000
    sSysMsg = VBA.Space(lMsgSize)
    lMsgSize = FormatMessage( _
        FORMAT_MESSAGE_FROM_SYSTEM, _
        ByVal 0&, _
        lErrCode, _
        0, _
        sSysMsg, _
        lMsgSize, _
        ByVal 0&)
    If lMsgSize = 0 Then
      sSysMsg = "System-Fehlercode: " & _
          VBA.Str$(lErrCode)
    Else: sSysMsg = VBA.Str$(lErrCode) & _
        ": " & VBA.Left$(sSysMsg, lMsgSize)
    End If
  Else
    sSysMsg = vbNullString
  End If
  GetDllErrorDescription = VBA.Trim(sSysMsg)
 
End Function


Zurück Tipp 1.4 - Ausführbarkeit prüfen | Inhalt | Tipp 1.6 - Dateien ermitteln Weiter