I have been building many applications using VBA to help users in automating processes. Somethings simply can’t be automated due to variability of some attribute. In my case determining the directory to use required input from the user. So I devised a simple function that will ask the user where the files are saved in a directory. The other code not mentioned in this post would extract the data from each file within the directory. First the application needed to know the correct file path to the directory to use.
I found the original code somewhere, but I never saved the source. Apologies for not attributing the original source. However, I know I made some modifications to suit my needs.
The function takes the input of a file path. This is if you know the general directory, but not the sub directory. The user can then select an ultimate directory within overall directory where the data being used is typically saved. Otherwise, the user would have to search through several directories to get to where it needs to go.
A valid file path is returned by the function, which then can be used within a sub or another function to know where to look for data.
Here is the code:
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 | 'Function purpose: To Browser for a user selected folder. 'If the "OpenAt" path is provided, open the browser at that directory 'If error with "OnenAt", browser will open at Desktop level Public Function BrowseForFolder(Optional OpenAt As Variant) As Variant Dim ShellApp As Object 'Create a file browser window. OpenAt is the user defined default folder. Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose the folder where the files are saved", 0, OpenAt) On Error Resume Next 'Save path to BrowseForFolder BrowseForFolder = ShellApp.self.Path On Error GoTo 0 'Destroy the Shell Application; no longer needed. Set ShellApp = Nothing 'Select the second character of BrowseForFolder Select Case Mid(BrowseForFolder, 2, 1) 'All invalid or non-entries go to Invalid error handling Case Is = ":" 'Valid selections can begin with drive letter If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid Case Is = "\" '"'Valid selections can start with 2 backslashes "\\" If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid Case Else GoTo Invalid End Select Exit Function Invalid: 'Set BrowseForFolder to False for invalid selections BrowseForFolder = False End Function |
Recommended for you
Leave a Reply
This site uses Akismet to reduce spam. Learn how your comment data is processed.
