VBA to create folder from data validation list and allow user to select folder

user_14006797 0
Viewed 197

I am encountering three problems with my code.

  1. When users select a save folder it always saves in the folder above. For example, if the address is "Dept\Financial Analysis Team - General\Mail Out", it will always save to the Financial Analysis Team - General folder even though the Mail Out is the folder I have clicked.
  2. I keep getting prompts to save with each time it loops. My macro loops through a data validation list, creates a folder (if none) and saves the specified PDF into their respective folders. The user is be able to select any folder they want in the selected Drive I have chosen.
  3. If I do not select a folder (i.e. cancel), the macro runs on its own and actually creates the folder and PDF.
Function selectfolder()
user_name = Environ("username")
Dim flder As FileDialog
Dim foldername As String
Set flder = Application.FileDialog(msoFileDialogFolderPicker) 'standard wording

'Prompt for folder creation
With flder
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Dept\"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode 'i.e. if OK is not pressed
foldername = .SelectedItems(1)

End With

NextCode:
GetFolder = foldername
Set flder = Nothing

End Function

Sub SaveActiveSheetAsPDF()

'Creating a message box to ask user
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub

Dim inputrange As Range
Dim cell As Range
Dim network, Address, Folder, Title As String

'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)

For Each cell In inputrange

   Range("G2").Value = cell.Value

'Defining the Network Folder variables
network = Range("C6").Value
Address = selectfolder
Folder = Address & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"

'Creating the folder based on Network - No existing folder
If Dir(Folder, vbDirectory) = "" Then
'Create a folder
MkDir Folder
'Save Active Sheet as PDF and to Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Folder & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

'Creating Only the PDF based on Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Folder & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

End If

Next cell
    
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"


End Sub
vba excel
2 Answers

  1. I suggest you break in your code at different parts to see what the variables are. (To add a breakpoint, click in gray area along left to add a red circle.)

    Folder = Address & network

Your "Address" variable likely doesn't end in a slash, so I'm guessing you'll need something like: Address & "\" & network

If you break on the line that creates the pdf, in the debug window you can type

?Folder & "\" & Title & ".pdf"

which will likely show why your files are not being saved in the location you are intending. You could also create a variable saveAs to store the full path, making it easier to see the value.

  1. You should move the code to ask user for directory toward the top, outside of your for loop. I assume you only need to ask for a directory once.

If the user doesn't select a folder, you want to exit, but you don't have code to handle this. Something like below should work:

address = SelectFolder
If address = "" Then
    MsgBox "Canceled."
    Exit Sub
End If
user_2791800

This is the correct code revised :)

Option Explicit
Function selectfolder()

Dim user_name As String
user_name = Environ("username")

'Prompt for folder creation
With Application.FileDialog(msoFileDialogFolderPicker) 'standard wording
.Title = "Select the folder to save"
.InitialFileName = "C:\Users\" & user_name & "\Department\" 'base directory to open
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function 'if user does not press OK, end the function'
selectfolder = .SelectedItems(1)

End With

End Function
Sub SaveActiveSheetAsPDF()

'Create a message box to ask user before proceeding
If MsgBox("This will print to PDFs. Continue?", vbYesNo + vbQuestion + vbDefaultButton2, "Printing to PDFs") = vbNo Then Exit Sub

'Defining the Type of Variables
Dim inputrange As Range
Dim cell As Range
Dim network, Address, Fldr, Title As String

'If user does not choose a folder
Address = selectfolder
If Address = "" Then
    Exit Sub
End If

'Determine (set) where validation comes from - create a reference point
Set inputrange = Evaluate(Range("G2").Validation.Formula1)

For Each cell In inputrange

   Range("G2").Value = cell.Value

'Defining the Company Network Folder variables
network = Range("C6").Value
Fldr = Address & "\" & network
Title = "MonthlyReport (" & Format(Range("C8"), "mmmm") & ") - " & ActiveSheet.Range("B2").Value & " (" & ActiveSheet.Range("G2").Value & ")"

'Creating the folder based on Company Network - No existing folder
If Dir(Fldr, vbDirectory) = "" Then
'Create a folder
MkDir Fldr
'Save Active Sheet as PDF and to Company Network file
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Fldr & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

'Creating Only the PDF based on Company Network - there is an existing folder
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Fldr & "\" & Title & ".pdf", _
    Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False

End If

Next cell
    
'Create a message box at end of task to inform user it is complete
MsgBox "Generation of PDF Reports and Folders Completed", vbInformation, "Complete"


End Sub
user_140067970
Related