Найти файл

[SCINER]

Найти файл в определенной папке с определенным именем используя приоритет (т.е. если в папке несколько файлов с одним именем но с разными расширениями то вернуть путь к файлу стоящий выше по заданному приоритету.)

Public Function FileByPriority(ByVal sPath As String, Optional ByVal Filename As String = "*", Optional ByVal Extensions As String = ".bmp;.jpg;.gif") As String
  sPath = sPath & IIf(VBA.Right$(sPath, 1) = "\", vbNullString, "\")
  Dim i As Long
  Dim ExT() As String
  Dim A As String
  ExT = Split(Extensions & ";", ";")
  For i = 0 To UBound(ExT)
    If A = vbNullString Then
      A = Dir$(sPath & Filename & ExT(i))
    Else
      Exit For
    End If
  Next
  If A <> vbNullString Then FileByPriority = sPath & A
End Function
 
'Пример
Private Sub Form_Load()
  Dim Tmp As String
  Tmp = FileByPriority("c:\", "1", ".bmp;.jpg;")
  MsgBox Tmp
End Sub

[SCINER]

Единственная правильная и самая точная функция поиска файлов/папок:

Option Explicit
 
'Created by SCINER: lenar2003@mail.ru
'Функция поиска файлов/папок
Private Const MAX_PATH = 260
 
Public Enum FindObjectType
  fNotFound = 0
  fFindFolder = 1
  fFindFile = 2
End Enum
 
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 Const INVALID_HANDLE_VALUE = -1
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
 
Private Sub Form_Load()
  Dim Tmp As String
  'Пример
  If Find("c:\1.bmp") = fFindFile Then MsgBox "Файл найден"
  If Find("c:\WINNT") = fFindFolder Then MsgBox "Папка найдена"
End Sub
 
'Если путь [Не найден] возвращает 0
'Если путь [Папка] возвращает 1
'Если путь [Файл] возвращает 2
Function Find(ByVal Path As String) As FindObjectType
  Dim lRet As Long
  Dim W32 As WIN32_FIND_DATA
  If VBA.Right$(Path, 1) = "\" Then Path = VBA.Left$(Path, Len(Path) - 1)
  lRet = FindFirstFile(Path, W32)
  If lRet = INVALID_HANDLE_VALUE Then Exit Function
  Call FindClose(lRet)
  Find = IIf(W32.dwFileAttributes And vbDirectory, fFindFolder, fFindFile)
End Function