Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Files Directories Drives Code Examples

Find a File on a Drive-Directory

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
Find a File on a Drive-Directory To search a directory or drive for a specified file or pattern use the following routine. Note, a test routine can be found at the bottom of the post. Option Explicit 'Purpose : Performs a recursive search starting from the specified directory ' to find the next matching file (uses the file scripting object) 'Inputs : sInitialDirectory The directory to begin the seach from ' sFilePattern The file pattern to seach for eg. "*.xls" 'Outputs : Returns the full path and name of the next matching file 'Notes : Can be called recursively to find all instances of the specified file pattern ' Requires a Reference to SCRRUN.DLL ("Microsoft Scripting Runtime") Function FileFindFirst(ByVal sInitialDirectory As String, ByVal sFilePattern As String) As String Static FSO As Scripting.FileSystemObject, oDirectory As Scripting.Folder, oThisDir As Scripting.Folder Static ssLastPattern As String, ssLastFiles As String Dim sThisPath As String, sResString As String, sTestFile As String If (FSO Is Nothing) = True Then Set FSO = New Scripting.FileSystemObject End If If Right$(sInitialDirectory, 1) <> "\" Then sInitialDirectory = sInitialDirectory & "\" End If 'Seach current directory sThisPath = sInitialDirectory sTestFile = Dir$(sThisPath & sFilePattern) Do If FileExists(sThisPath & sTestFile) Then If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then 'Found next matching file sResString = sThisPath & sTestFile Exit Do End If Else 'No more matching files in this directory Exit Do End If 'Get next matching file sTestFile = Dir$ Loop If Len(sResString) = 0 Then 'File not found in sInitialDirectory, search sub directories... Set oDirectory = FSO.GetFolder(sInitialDirectory) For Each oThisDir In oDirectory.SubFolders sThisPath = oThisDir.Path If Right$(sThisPath, 1) <> "\" Then sThisPath = sThisPath & "\" End If sTestFile = Dir$(sThisPath & sFilePattern) Do If FileExists(sTestFile) Then If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then 'Found next matching file sResString = sInitialDirectory & sTestFile End If Else 'No more matching files in this directory, check it's subfolders sTestFile = FileFindFirst(sThisPath, sFilePattern) If FileExists(sTestFile) Then If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then 'Found next matching file sResString = sTestFile Exit Do End If Else 'File not found in sub folder Exit Do End If End If sTestFile = Dir$ Loop If Len(sResString) Then 'Found next matching file Exit For End If Next End If If Len(sResString) Then 'Store search parameters If sFilePattern = ssLastPattern Then 'Routine has been called with same parameters, store all previously matching files ssLastFiles = ssLastFiles & "|" & sResString Else 'Store matching file ssLastFiles = "|" & sResString End If ssLastPattern = sFilePattern 'Return result FileFindFirst = sResString End If End Function 'Purpose : Checks if a file exists 'Inputs : sFilePathName The path and file name e.g. "C:\Autoexec.bat" 'Outputs : Returns True if the file exists Function FileExists(sFilePathName As String) As Boolean On Error GoTo ExitFunction If Len(sFilePathName) Then If (GetAttr(sFilePathName) And vbDirectory) < 1 Then 'File Exists FileExists = True End If End If ExitFunction: End Function 'Demonstration Routine Sub Test() Dim sFile As String 'Find all instances of SCRRUN.DLL Debug.Print "Search for SCRRUN.DLL----------" Do sFile = FileFindFirst("C:", "SCRRUN.DLL") If Len(sFile) Then Debug.Print sFile Else Debug.Print "--------END OF SEARCH" Exit Do End If Loop 'Find all the "bas" files on the c drive Debug.Print "Search for *.bas----------" Do sFile = FileFindFirst("C:\", "*.bas") If Len(sFile) Then Debug.Print sFile Else Debug.Print "--------END OF SEARCH" Exit Do End If Loop End Sub