Test existence souboru nebo adresß°e

Option Explicit
Public Const MAX_PATH = 260
Private Const ERROR_NO_MORE_FILES = 18&Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100

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 Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As _
    Long) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
    (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long


Function StripTerminator(ByVal strString As String) As String

    Dim intZeroPos As Integer
    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If

End Function

Function FileOrDirExists(Optional ByVal sFile As String = "", _
        Optional ByVal sFolder As String = "") As Boolean

    Dim lpFindFileData As WIN32_FIND_DATA
    Dim lFileHdl  As Long
    Dim sTemp As String
    Dim sTemp2 As String
    Dim lRet As Long
    Dim iLastIndex  As Integer
    Dim strPath As String
    Dim sStartDir As String
    
    On Error Resume Next
    'pokud jsou oba parametry prßzdnΘ ukonΦφ funkci
    If sFile = "" And sFolder = "" Then Exit Function
    'pokud jsou oba parametry plnΘ o°e₧e adresß°
    If sFile <> "" And sFolder <> "" Then sFolder = ""
    If sFolder <> "" Then
        'Nastavenφ startovacφho adresß°e
        sStartDir = sFolder
    Else
        'zjiÜt∞nφ poΦßteΦnφho  adresß°e z cesty souboru
        sStartDir = Left$(sFile, InStrRev(sFile, "\"))
        'zjiÜt∞nφ jmΘna souboru
        sFile = Right$(sFile, Len(sFile) - InStrRev(sFile, "\"))
    End If
    'Pokud je to nutnΘ, p°idßme backslash
    If Right$(sStartDir, 1) <> "\" Then sStartDir = sStartDir & "\"
    
    sStartDir = sStartDir & "*.*"
    
    'ZjiÜt∞nφ ukazatele na soubor
    lFileHdl = FindFirstFile(sStartDir, lpFindFileData)
    
    If lFileHdl <> -1 Then
        If sFolder <> "" Then
            'Adresß° existuje
            FileOrDirExists = True
        Else
            Do Until lRet = ERROR_NO_MORE_FILES
                strPath = Left$(sStartDir, Len(sStartDir) - 4) & "\"
                If (lpFindFileData.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = vbNormal Then
                    sTemp = StrConv(StripTerminator(lpFindFileData.cFileName), vbProperCase)
                    If LCase$(sTemp) = LCase$(sFile) Then
                        FileOrDirExists = True '// file found
                        Exit Do
                    End If
                End If
                lRet = FindNextFile(lFileHdl, lpFindFileData)
                If lRet = 0 Then Exit Do
            Loop
        End If
    End If
    'Zav°enφ ukazatele
    lRet = FindClose(lFileHdl)

End Function

P°φklad volßnφ:

Private Sub Command1_Click()

    'test existence souboru
    If FileOrDirExists("c:\temp.txt") Then
        MsgBox "Soubor 'C:\temp.txt' existuje"
    Else
        MsgBox "Soubor 'C:\temp.txt' neexistuje"
    End If

    'test existence adresß°e
    If FileOrDirExists(, "c:\test directory") Then
        MsgBox "Adresß° 'c:\test directory' existuje"
    Else
        MsgBox "Adresß° 'c:\test directory' neexistuje"
    End If

End Sub

Zp∞t