Advanced Files & Folders

Does it exist?

Nearly everyone has used the Dir function in VB, and nearly everyone has been disappointed. It can be very slow (when used in loops), and produces unreliable results when used on a network. A much better way is to use the FindFirstFile and FindNextFile windows api calls. To try this out, add the following code to a module

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, lFileHdl  As Long
    Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex  As Integer
    Dim sPath As String
    Dim sStartDir As String
    
    On Error Resume Next
    '// both params are empty
    If sFile = "" And sFolder = "" Then Exit Function
    '// both are full, empty folder param
    If sFile <> "" And sFolder <> "" Then sFolder = ""
    If sFolder <> "" Then
        '// set start directory
        sStartDir = sFolder
    Else
        '// extract start directory from file path
        sStartDir = Left$(sFile, InStrRev(sFile, ""))
        '// just get filename
        sFile = Right$(sFile, Len(sFile) - InStrRev(sFile, ""))
    End If
    '// add trailing to start directory if required
    If Right$(sStartDir, 1) <> "" Then sStartDir = sStartDir & ""
    
    sStartDir = sStartDir & "*.*"
    
    '// get a file handle
    lFileHdl = FindFirstFile(sStartDir, lpFindFileData)
    
    If lFileHdl <> -1 Then
        If sFolder <> "" Then
            '// folder exists
            FileOrDirExists = True
        Else
            Do Until lRet = ERROR_NO_MORE_FILES
                strPath = Left$(sStartDir, Len(sStartDir) - 4) & ""
                '// if it is a file
                If (lpFindFileData.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = vbNormal Then
                    sTemp = StrConv(StripTerminator(lpFindFileData.cFileName), vbProperCase)
                    '// remove LCase$ if you want the search to be case sensitive (unlikely!)
                    If LCase$(sTemp) = LCase$(sFile) Then 
                        FileOrDirExists = True '// file found
                        Exit Do
                    End If
                End If
                '// based on the file handle iterate through all files and dirs
                lRet = FindNextFile(lFileHdl, lpFindFileData)
                If lRet = 0 Then Exit Do
            Loop
        End If
    End If
    '// close the file handle
    lRet = FindClose(lFileHdl)
End Function

Now add a command button to a form, and add the following code

Private Sub Command1_Click()
    '// test if file exists
    If FileOrDirExists("c:\temp.txt") Then
        Msgbox "The file 'C:\temp.txt' exists"
    Else
        Msgbox "The file 'C:\temp.txt' does not exist"
    End If

    '// test if folder exists
    If FileOrDirExists(,"c:\test directory") Then
        Msgbox "The folder 'c:\test directory' exists"
    Else
        Msgbox "The folder 'c:\test directory' does not exist"
    End If
End Sub

You might also like...

Comments

About the author

James Crowley

James Crowley United Kingdom

James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audien...

Interested in writing for us? Find out more.

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“It is practically impossible to teach good programming style to students that have had prior exposure to BASIC. As potential programmers, they are mentally mutilated beyond hope of regeneration.” - E. W. Dijkstra