Advertisement
Guest User

Untitled

a guest
Jun 20th, 2019
61
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.66 KB | None | 0 0
  1. Sub SetFileLocation()
  2. Dim Ret
  3.  
  4. strUserName = Environ("UserName")
  5.  
  6. strPath = "C:documents and settings" & strUserName & "Desktop"
  7.  
  8.  
  9. '~~> Specify your start folder here
  10. Ret = BrowseForFolder(strPath)
  11.  
  12. Forms.frmmainform.lblFolderLocation.Caption = strFolderLocation
  13.  
  14.  
  15.  
  16. End Sub
  17.  
  18. Function BrowseForFolder(Optional OpenAt As Variant) As Variant
  19. 'Function purpose: To Browser for a user selected folder.
  20. 'If the "OpenAt" path is provided, open the browser at that directory
  21. 'NOTE: If invalid, it will open at the Desktop level
  22.  
  23. Dim ShellApp As Object
  24.  
  25. 'Create a file browser window at the default folder
  26. Set ShellApp = CreateObject("Shell.Application"). _
  27. BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
  28.  
  29.  
  30.  
  31. 'Set the folder to that selected. (On error in case cancelled)
  32. On Error Resume Next
  33. BrowseForFolder = ShellApp.self.Path
  34. On Error GoTo 0
  35. Debug.Print BrowseForFolder
  36. strFolderLocation = BrowseForFolder
  37. Debug.Print strFolderLocation
  38. 'Destroy the Shell Application
  39. Set ShellApp = Nothing
  40.  
  41. 'Check for invalid or non-entries and send to the Invalid error
  42. 'handler if found
  43. 'Valid selections can begin L: (where L is a letter) or
  44. '\ (as in \servernamesharename. All others are invalid
  45. Select Case Mid(BrowseForFolder, 2, 1)
  46. Case Is = ":"
  47. If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
  48. Case Is = ""
  49. If Not Left(BrowseForFolder, 1) = "" Then GoTo Invalid
  50. Case Else
  51. GoTo Invalid
  52. End Select
  53.  
  54. Exit Function
  55.  
  56. Invalid:
  57. 'If it was determined that the selection was invalid, set to False
  58. BrowseForFolder = False
  59. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement