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
Related
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?
my code prompts user to save the current file as a macro free file, the problem is that if the user hits cancel then i get an error. i need my code to start over when the user hits cancel. so it would be best if a message box pops up and says please select location to save file and then the dialog box pops up again so the user can select where to save file, and if user hits cancel again then just exit.
Sub SaveWithoutMacro()
Dim objFolder As Object, objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ChooseFolder)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=objFolder & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".xlsx", FileFormat:=51, password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
If objFolder <> False Then Exit SaveWithoutMacro = objFolder
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function ChooseFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder to save down the copy of this workbook"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
If you want to avoid the error you have on "Cancel" (coming from the fact that you execute Set objFolder = objFSO.GetFolder(ChooseFolder) on an empty string (since ChooseFolder() returns empty if the user cancels the action) and at the same time ask him twice - why'd you want to ask them twice? - then you should write your macro like this:
Sub SaveWithoutMacro()
folderPath = ChooseFolder() '<-- ask them to select once
If folderPath = "" Then '<-- if they clicked cancel once
MsgBox "You didn't select a folder", vbCritical, "Are you sure?" '<-- message box to inform them
folderPath = ChooseFolder() '<-- ask them again to select
If folderPath = "" Then Exit Sub '<-- if again empty, then exit procedure
End If
'rest of your save code
I dont recommend doing this as it can really annoy the user, but basically you just put it into a Do Loop - something like this (untested)
With fldr
.Title = "Select a Folder to save down the copy of this workbook"
.AllowMultiSelect = False
.InitialFileName = strPath
Do Until .Show <> -1
If .SelectedItems(1) <> "" Then GoTo NextCode
Loop
End With
NextCode:
ChooseFolder = .SelectedItems(1)
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
I wrote a macro that asks you the folder where to save all the graphs of a worksheet using a message box, but at the and the graphs are saved not in the desired folder, but in the parent one.
For example, instead of saving in C:\parent\desiredFolder it saves in C:\parent\
Thank you for your help.
Sub EXPORTCHARTS()
MsgBox ("Seleziona la cartella dove vuoi esoportare i grafici")
ActiveSheet.Select
ActiveWindow.Zoom = 400
Dim sItem As String
Dim dlgOpenFolder As FileDialog
Set dlgOpenFolder = Application.FileDialog(msoFileDialogFolderPicker)
dlgOpenFolder.Filters.Clear
With dlgOpenFolder
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = dlgOpenFolder
' ---------------------------------------------------------
Dim objCht As ChartObject
i = 1
For Each objCht In ActiveSheet.ChartObjects
objCht.Chart.Export Filename:=i & ".jpg", FilterName:="JPG"
i = i + 1
Next objCht
' ---------------------------------------------------------
ActiveWindow.Zoom = 50
End Sub
Jbjstam pointed out in their answer that you aren't using the folder name when you are saving the files.
You also had issues with your logic if the user cancelled from the FileDialog as, even if you correctly used sItem in your loop, sItem would never be set and therefore the files would be being saved to the current directory.
The following should work:
Sub EXPORTCHARTS()
MsgBox ("Seleziona la cartella dove vuoi esoportare i grafici")
ActiveSheet.Select
ActiveWindow.Zoom = 400
Dim sItem As String
Dim dlgOpenFolder As FileDialog
Dim i As Long
Set dlgOpenFolder = Application.FileDialog(msoFileDialogFolderPicker)
dlgOpenFolder.Filters.Clear
With dlgOpenFolder
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then
MsgBox "No path selected"
Exit Sub
End If
sItem = .SelectedItems(1)
End With
' ---------------------------------------------------------
Dim objCht As ChartObject
i = 1
For Each objCht In ActiveSheet.ChartObjects
objCht.Chart.Export Filename:=sItem & "\" & i & ".jpg", FilterName:="JPG"
i = i + 1
Next objCht
' ---------------------------------------------------------
ActiveWindow.Zoom = 50
End Sub
You don't use the variable fldr in the loop that exports the charts...
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.