Set a default folder when trying to save/print file

Cuzzaa

Board Regular
Joined
Apr 30, 2019
Messages
86
Hi Everyone

I hope you can help. I am a bit stuck.

I am using the below code to run a macro to print a selection of data to PDF in a destination folder. At the moment this prompts the user to select which folder/directory to select.

My intention is that I want to set a default folder directory so that on click of the macro the user is forced to save the file in a specific folder, rather than having to browse to it each time.

Please can you assist with what extra line of code is needed to accomplish this and set the default folder for e.g. to: C:\Users\username\Desktop\newfolder?

Code:
Sub GenerateQuote()
    Dim response As VbMsgBoxResult




' GenerateQuote Macro
'
    
    With Worksheets("Dashboard")
        If Len(.Range("O19").Value) = 0 Then
            response = MsgBox("You have not added any caveats or assumptions!" & Chr(10) & Chr(10) & "Are you sure you want to continue?", 36, "Caveats & Assumptions")
            If response = vbNo Then .Activate: .Range("O19").Select: Exit Sub
        End If
    End With
    
    Worksheets("Quotation").PrintOut Copies:=1, Collate:=True, _
            IgnorePrintAreas:=False
            
    MsgBox "Your quote has been generated!", vbInformation




End Sub

Many thanks in advance.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
The following macro assumes you want to save the "Quotation" sheet (in red) as a PDF file. Change the name to suit your needs. Also, change the folder path (in blue) to suit you needs.
Code:
Sub GenerateQuote()
    Application.ScreenUpdating = False
    Dim response As VbMsgBoxResult
    With Worksheets("Dashboard")
        If Len(.Range("O19").Value) = 0 Then
            response = MsgBox("You have not added any caveats or assumptions!" & Chr(10) & Chr(10) & "Are you sure you want to continue?", 36, "Caveats & Assumptions")
            If response = vbNo Then .Activate: .Range("O19").Select: Exit Sub
        End If
    End With
    Sheets("Quotation").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    ChDir "[COLOR="#0000FF"]C:\Users\username\Desktop\newfolder\[/COLOR]" 
    Sheets("[COLOR="#FF0000"]Quotation[/COLOR]").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveSheet.Name _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    MsgBox "Your quote has been generated!", vbInformation
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
The following macro assumes you want to save the "Quotation" sheet (in red) as a PDF file. Change the name to suit your needs. Also, change the folder path (in blue) to suit you needs.
Code:
Sub GenerateQuote()
    Application.ScreenUpdating = False
    Dim response As VbMsgBoxResult
    With Worksheets("Dashboard")
        If Len(.Range("O19").Value) = 0 Then
            response = MsgBox("You have not added any caveats or assumptions!" & Chr(10) & Chr(10) & "Are you sure you want to continue?", 36, "Caveats & Assumptions")
            If response = vbNo Then .Activate: .Range("O19").Select: Exit Sub
        End If
    End With
    Sheets("Quotation").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    ChDir "[COLOR=#0000FF]C:\Users\username\Desktop\newfolder\[/COLOR]" 
    Sheets("[COLOR=#FF0000]Quotation[/COLOR]").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveSheet.Name _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    MsgBox "Your quote has been generated!", vbInformation
    Application.ScreenUpdating = True
End Sub

Hello

Thank you very much for your help.

I have tried copying/pasting your code yet I am still greeted with saving it to my desktop. This is probably my user error but I am pretty sure I'm using the code as I should be. Would you mind double checking for me?

Thanks so much.
 
Upvote 0
The path you posted (C:\Users\username\Desktop\newfolder\) saves the file to a folder named "newfolder" on your Desktop. You would have to change "username" to your actual user name. Do you want to save the file to the Desktop or in a different location?
 
Upvote 0
The path you posted (C:\Users\username\Desktop\newfolder\) saves the file to a folder named "newfolder" on your Desktop. You would have to change "username" to your actual user name. Do you want to save the file to the Desktop or in a different location?

I have set the directory to the actual directory I need (the folder does exist) yet it still opens my Desktop as the default folder location.

Many thanks
 
Upvote 0
Can you post your entire macro with the actual directory? Also, when you respond, please click the "Reply" button instead of the "Reply With Quote" button. This keeps the responses a little more tidy.
 
Upvote 0
Hi Mumps

Please see my code below, any ideas? It's probably just me of course!

Code:
Sub NewQuoteGenerate()    Application.ScreenUpdating = False
    Dim response As VbMsgBoxResult
    With Worksheets("Dashboard")
        If Len(.Range("O19").Value) = 0 Then
            response = MsgBox("You have not added any caveats or assumptions!" & Chr(10) & Chr(10) & "Are you sure you want to continue?", 36, "Caveats & Assumptions")
            If response = vbNo Then .Activate: .Range("O19").Select: Exit Sub
        End If
    End With
    Sheets("Quotation").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    ChDir "Z:\General\Shared\IBC\NewQuotes"
    Sheets("Quotation").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveSheet.Name _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    MsgBox "Your quote has been generated!", vbInformation
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try replacing this line of code:
Code:
ChDir "Z:\General\Shared\IBC\NewQuotes"
with this line:
Code:
ChDir "Z:\General\Shared\IBC\NewQuotes[COLOR="#FF0000"]\[/COLOR]"
The missing backslash (in red) may have been the problem.
 
Upvote 0
Hi mumps

I'm afraid it's still prompting me to save on my desktop.

Would you be so kind to have any other suggestions?

Thanks so much
 
Upvote 0
I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do using a few examples from your data and referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,260
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top