Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub SetFileLocation()
- Dim Ret
- strUserName = Environ("UserName")
- strPath = "C:documents and settings" & strUserName & "Desktop"
- '~~> Specify your start folder here
- Ret = BrowseForFolder(strPath)
- Forms.frmmainform.lblFolderLocation.Caption = strFolderLocation
- End Sub
- Function BrowseForFolder(Optional OpenAt As Variant) As Variant
- 'Function purpose: To Browser for a user selected folder.
- 'If the "OpenAt" path is provided, open the browser at that directory
- 'NOTE: If invalid, it will open at the Desktop level
- Dim ShellApp As Object
- 'Create a file browser window at the default folder
- Set ShellApp = CreateObject("Shell.Application"). _
- BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
- 'Set the folder to that selected. (On error in case cancelled)
- On Error Resume Next
- BrowseForFolder = ShellApp.self.Path
- On Error GoTo 0
- Debug.Print BrowseForFolder
- strFolderLocation = BrowseForFolder
- Debug.Print strFolderLocation
- 'Destroy the Shell Application
- Set ShellApp = Nothing
- 'Check for invalid or non-entries and send to the Invalid error
- 'handler if found
- 'Valid selections can begin L: (where L is a letter) or
- '\ (as in \servernamesharename. All others are invalid
- Select Case Mid(BrowseForFolder, 2, 1)
- Case Is = ":"
- If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
- Case Is = ""
- If Not Left(BrowseForFolder, 1) = "" Then GoTo Invalid
- Case Else
- GoTo Invalid
- End Select
- Exit Function
- Invalid:
- 'If it was determined that the selection was invalid, set to False
- BrowseForFolder = False
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement