How to set multiple directories with using one file dialog function - vba

I'm using function to set database directory at Excel with FileDialog, But I have to set about 20 different database directory
I set up one of it with SettingsSheet.databaseDirectory0 = sItem, but for the others, I don't want to write the same function for each of them isn't there any
parametric solution to set them to one function?
Function GetFolder() As String
Dim fdo As FileDialog
Dim sItem As String
Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
With fdo
.Title = "Select a Directory"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
SettingsSheet.databaseDirectory0.Value = sItem
End With
NextCode:
GetFolder = sItem
Set fdo = Nothing
End Function

Pass it the control. Something along the lines of this:
Function GetFolder(txt As Control) As String
Dim fdo As FileDialog
Dim sItem As String
Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
With fdo
.Title = "Select a Directory"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
txt.Value = sItem
End With
NextCode:
GetFolder = sItem
Set fdo = Nothing
End Function
This pseudo-code demonstrates how to make the function generic. See how I'm passing the control to the function and then referencing that instead of the databaseDirectory0?

You can return sItem to the parent caller and set
SettingsSheet.databaseDirectory0n.Value = functionName(txt as Control)
Does this make sense?

Related

User defined type not defined error in Catia VBA

I'm trying to add a browse button to browse the folder.
Private Sub BrowseButton_Click()
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
With fldr
.Title = “Select a File”
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFile = sItem
Set fldr = Nothing
End Sub
I get
User - defined type is not defined.

VBA FileDialog.Show restarts sub

I'm trying to get the path for a folder using the filedialog.show function.
The issue I am facing is:
After I select a folder in the folderpicking window the code does not continue. It either restarts or it ends without anything happening.
What could be the problem?
[...]
Dim fpath As Variant
Dim fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Title = "Select a Folder"
fldr.AllowMultiSelect = False
fldr.InitialFileName = Application.DefaultFilePath
If fldr.Show = -1 Then
fpath = fldr.SelectedItems(1)
Else
GoTo NextCode
End If
NextCode:
set fldr = Nothing
[...]
It works, you are just not using it to display the path result (or return a String value from this Sub).
Change your code:
If fldr.Show = -1 Then
fpath = fldr.SelectedItems(1)
Else
GoTo NextCode
End If
NextCode:
set fldr = Nothing
To:
If fldr.Show = -1 Then
fpath = fldr.SelectedItems(1)
MsgBox fpath ' <-- for DEBUG
End If
Set fldr = Nothing
If you want to use your code as a Function that returns the path of the selected folder, use the code below:
Function GetFolderPath() As String
Dim fpath As Variant
Dim fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show = -1 Then
GetFolderPath = .SelectedItems(1)
End If
End With
Set fldr = Nothing
End Function
And the Sub code to test it:
Sub Test()
Dim FolderPath As String
FolderPath = GetFolderPath
MsgBox FolderPath
End Sub

Using Application.FileDialog from a different VBA application

I'm using CAM software called AlphaCAM which has Visual Basic integrated into its software. I'm trying to run a button within a userform utilizing the file dialog object to return a folder path. However, it does not recognize the FileDialog object and I believe it is because I'm working outside of an office application. Here is my code:
Private Sub Command_FindFolder_Click()
Dim fldr As FileDialog
Dim foldername As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
foldername = .SelectedItems(1)
End With
NextCode:
Set fldr = Nothing
TB_FolderName.Value = foldername
End Sub
I've also tried changing the variable fldr to "Dim fldr As Object" but the code still trips on "Application.FileDialog".
Is there loop hole around this? Can I open an excel window just to run the file dialog?
Thanks for your help!
"Can I open an excel window just to run the file dialog?"
Yes you can:
Private Sub Command_FindFolder_Click()
Dim fldr, xlApp
Dim foldername
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set fldr = xlApp.FileDialog(4) 'msoFileDialogFolderPicker
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = xlApp.DefaultFilePath
If .Show = -1 Then foldername = .SelectedItems(1)
End With
Set fldr = Nothing
xlApp.DisplayAlerts = False
xlApp.Quit
Set xlApp = Nothing
'TB_FolderName.Value = foldername
WScript.Echo foldername
End Sub
I think your intention is something like that:
Sub foo()
Dim shell: Set shell = CreateObject("Shell.Application")
Dim file: Set file = shell.BrowseForFolder(0, "Choose a file:", &H4000)
BrowseForFile = file.self.Pat
End Sub

VBA - Avoid error when cancel getfolder

I am getting a basic error when I cancel the selection of a folder. I just want to Exit Sub when press the cancel button.
I'm using the following code
Set recsFolder = fso.GetFolder(Functions.GetFolder("C:\"))
Function GetFolder(strPath As String) As String
Dim Fldr As FileDialog
Dim sItem As String
Set Fldr = Application.FileDialog(msoFileDialogFolderPicker)
With Fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set Fldr = Nothing
End Function
A suggestion from one of the best source : http://www.cpearson.com/excel/browsefolder.aspx
Function BrowseFolder(Title As String, _
Optional InitialFolder As String = vbNullString, _
Optional InitialView As Office.MsoFileDialogView = msoFileDialogViewList)_
As String
Dim V As Variant
Dim InitFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = Title
.InitialView = InitialView
If Len(InitialFolder) > 0 Then
If Dir(InitialFolder, vbDirectory) <> vbNullString Then
InitFolder = InitialFolder
If Right(InitFolder, 1) <> "\" Then
InitFolder = InitFolder & "\"
End If
.InitialFileName = InitFolder
End If
End If
.Show
On Error Resume Next
Err.Clear
V = .SelectedItems(1)
If Err.Number <> 0 Then
V = vbNullString
End If
End With
BrowseFolder = CStr(V)
End Function
The error happen in
Set recsFolder = fso.GetFolder(Functions.GetFolder("C:\"))
Because your function GetFolder returns an empty string when you cancel the folder selection
QUick solution, just change your logic to this:
Dim strReturned As String
strReturned = Functions.GetFolder("C:\")
If strReturned <> "" Then
Set recsFolder = fso.GetFolder(strReturned)
End If
to bypass the Set recsFolder if the folder is empty
I've read all of your answers and thank you for them, but I couldn't manage to apply them. Instead I have used the error handling (which I know I should avoid, but it won't damage the code).
On Error GoTo ErrHandlr:
Set recsFolder = fso.GetFolder(Functions.GetFolder("C:\"))
ErrHandlr:
Exit Sub

FileOpenDialog requires 2 "OK" clicks to return value?

I'm using VBA to create a FileOpenDialog object so that the user can select a directory. Here's my test code:
Function GetFolder(InitDir As String) As String
Dim fldr As FileDialog
Dim sItem As String
sItem = InitDir
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Please select a folder, then press OK to continue"
.AllowMultiSelect = False
If Right(sItem, 1) <> "\" Then
sItem = sItem & "\"
End If
.InitialFileName = sItem
If .Show = 0 Then
GetFolder = ""
Exit Function
End If
If .Show <> -1 Then
sItem = InitDir
Else
sItem = .SelectedItems(1)
End If
End With
GetFolder = sItem
Set fldr = Nothing
End Function
sub test()
dim selectedDir as variant
selectedDir=getFolder("c:")
msgbox selectedDir
end sub
But the dialog box created by this function requires that the user click OK twice to select whatever folder they've clicked on. Is there any way to make it so they only have to click OK once?
You call .Show() twice. So the dialog shows twice. Each time you only have to click OK once.
Call .Show only once and save the returned value to a variable to test later.