Save defined range as pdf where I choose the subfolder to place the file

[sspatriots]

I thought I was done for today and then came across this issue with another macro I'm trying to make work. I want to print a defined range on my currently Active Worksheet to a ".pdf" file so that the range fits all on one page. I need it to take me to a defined file path that has many folders beneath it that I need to choose from to save it under.

For example:

H:\PO Block History\ is the parent folder that has about 10 subfolders beneath it with the name of a year.

H:\PO Block History\2013
H:\PO Block History\2014
H:\PO Block History\2015
H:\PO Block History\2016
H:\PO Block History\2017
H:\PO Block History\2018
H:\PO Block History\2019
H:\PO Block History\2020
H:\PO Block History\2021
H:\PO Block History\2022

When the code gets to the point where I need to select one of these folders to put it in I need to be able to choose where it goes. I need the ".pdf" file name to come from the values in cells K6, L6 & D20 (with a space between L6 & D20).

So the file name may look like "2022-999 123 Bachelor Quarters"
Where,
K6 = 2022
L6 = -999
D20 = 123 Bachelor Quarters

The defined range is B1:L60


Below is what I have found to start with...


Sub SaveRangeAsPDF()

'Create and assign variables
Dim saveLocation As String
Dim rng As Range
Dim ws As Worksheet

Set ws = ActiveSheet
saveLocation = "H:\PO Block History\"
Set rng = ActiveSheet.Range("B1:L60")

'Save a range as PDF
rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation

End Sub

 

[Micron]

Sounds like what you need to incorporate a folder picker such as msoFileDialogFolderPicker and pass the folder path to the variable. Not sure what you're looking/asking for - maybe how to build the entire path using the picker and referring to the sheet cells for the file name? FWIW, I never name anything where that includes spaces (or special characters). Just that it sometimes causes coding problems that can be avoided.

 

[sspatriots]

Correct. I would like to start with the folder H:\PO Block History\ and then be able to choose one of the year folders that I want to place the ".pdf" file into. The name of the pdf will come from the cells that I pointed out. The spaces can be replaced with underscores. Basically the D20 is a Job Name and they want to see that in the file name to identify what that PO goes to.

 

[sspatriots]

I have tinkered with it this morning and come up with the two different codes shown below.

This first one will create the .pdf file and format it nicely for printing purposes, but will only create it to a specified folder

Sub SaveAsPDF()

'This one will create the .pdf file, but will only create it to a specified folder

Dim FileAndLocation As Variant
Dim strPathLocation As String
Dim strFilename As String
Dim strPathFile As String
Dim ws As Worksheet

Set ws = ActiveSheet

strPathLocation = ActiveSheet.Range("D2").Value
strFilename = ActiveSheet.Range("D1").Value
strPathFile = strPathLocation & strFilename



ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPathLocation & strFilename & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

'This is the concatenated value of selected folder location and filename

'Part of first code that was working except did not create a .pdf
'MsgBox FileAndLocation

End Sub

****************************************************************************************************************************************************************************************************************
This second one will act like it is creating a .pdf file and seems to let me place it in the subfolder I choose, but never actually creates anything and even it if does, I don't think it will format the file for printing like the first one does.


Sub SaveAsPDF2()

Dim FileAndLocation As Variant
Dim strPathLocation As String
Dim strFilename As String
Dim strPathFile As String
Dim ws As Worksheet

Set ws = ActiveSheet

strPathLocation = ActiveSheet.Range("D2").Value
strFilename = ActiveSheet.Range("D1").Value
strPathFile = strPathLocation & strFilename

'Working Somewhat, but not actually creating a .pdf file
FileAndLocation = Application.GetSaveAsFilename _
(InitialFileName:=strFilename, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'This is the concatenated value of selected folder location and filename

End Sub

 

[sspatriots]

Finally figured it out... Found some code on this forum and tweaked it to work in my favor.

Sub pdf()

If Range("D1").Value = "" Then GoTo err
Dim folder As FileDialog
Dim Fldr As String
Set folder = Application.FileDialog(msoFileDialogFolderPicker)

Fldr = ActiveSheet.Range("D2").Value

With folder
.AllowMultiSelect = False
If .Show <> -1 Then GoTo err
Fldr = .SelectedItems.Item(1)
End With
Application.DisplayAlerts = False


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fldr & "\" & Range("D1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False


Exit Sub
err:
MsgBox "FILE NOT SAVED - 'OK' to continue"
Exit Sub
End Sub

 

[sspatriots]

Well, I spoke to soon. I thought I had it, but now when I try and use the same code for saving the same pdf to a different folder (because they save the file in two places, dumb I know...) it only memorizes the file path in cell D2 every time I run the code. The second macro is identical, but it has a different file path I want to start in for D3. I'm obviously not doing something right to get the code recognize the correct file path. See both below:

Sub SaveAsPDFToG2POArchive()

If Range("D1").Value = "" Then GoTo err
Dim folder As FileDialog
Dim Fldr As String
Set folder = Application.FileDialog(msoFileDialogFolderPicker)

Fldr = ActiveSheet.Range("D2").Value

With folder
.AllowMultiSelect = False
If .Show <> -1 Then GoTo err
Fldr = .SelectedItems.Item(1)
End With
Application.DisplayAlerts = False


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fldr & "\" & Range("D1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False


Exit Sub
err:
MsgBox "FILE NOT SAVED - 'OK' to continue"
Exit Sub

End Sub
**********************************************************************************************************************************************************************************************************************
Sub SaveAsPDFToJobPOFolder()

If Range("D1").Value = "" Then GoTo err
Dim folder As FileDialog
Dim Fldr As String
Set folder = Application.FileDialog(msoFileDialogFolderPicker)

Fldr = ActiveSheet.Range("D3").Value

With folder
.AllowMultiSelect = False
If .Show <> -1 Then GoTo err
Fldr = ActiveSheet.Range("D3").Value
End With
Application.DisplayAlerts = False


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fldr & "\" & Range("D1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False


Exit Sub
err:
MsgBox "FILE NOT SAVED - 'OK' to continue"
Exit Sub

End Sub

 

[Micron]

Not sure I see the point of the file dialog if your paths are supposed to be coming from the sheet. Perhaps what you need is a counter. If paths will always be in the same cells each time, then something like

For i = 2 To 3
  Fldr = ActiveSheet.Range("D" & i)
  'do stuff to save file
Next

You don't need Exit Sub just before End Sub. If I understand what you're doing, you should only need 1 sub. If I don't understand, perhaps a sample of the data that matters would help.
If you could enclose your code in code tags (vba button on posting toolbar) and maintain indentation that would be nice.

 

[sspatriots]

I have messed with it quite a bit more. I have both codes allowing me to drill down from an initial starting folder now to where I need to put the file, however, the file is placed in the next to last folder I select. I'm sure this can be a simple fix, but will need help with it. I have to leave for this morning because they are running me out of here at noon. Any help getting to a final solution would be greatly appreciated.

Sub SelectFolder3()
Dim sFolder As String
' Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "G:\Automobiles\Cars\"
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
End If
End With

If sFolder <> "" Then ' if a file was chosen
' *********************

If Range("D1").Value = "" Then GoTo err
Dim folder As FileDialog

Application.DisplayAlerts = False

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("D1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

Exit Sub
err:
MsgBox "FILE NOT SAVED - 'OK' to continue"
Exit Sub

' put your code in here
' *********************
End If
End Sub
****************************************************************************************************************************************************************************************************************
Sub SelectFolder4()
Dim sFolder As String
' Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "G:\Automobiles\Trucks\"
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
End If
End With

If sFolder <> "" Then ' if a file was chosen
' *********************

If Range("D1").Value = "" Then GoTo err
Dim folder As FileDialog

Application.DisplayAlerts = False

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("D1").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

Exit Sub
err:
MsgBox "FILE NOT SAVED - 'OK' to continue"
Exit Sub

' put your code in here
' *********************
End If
End Sub

 

[sspatriots]

Not sure I see the point of the file dialog if your paths are supposed to be coming from the sheet. Perhaps what you need is a counter. If paths will always be in the same cells each time, then something like

For i = 2 To 3
  Fldr = ActiveSheet.Range("D" & i)
  'do stuff to save file
Next

You don't need Exit Sub just before End Sub. If I understand what you're doing, you should only need 1 sub. If I don't understand, perhaps a sample of the data that matters would help.
If you could enclose your code in code tags (vba button on posting toolbar) and maintain indentation that would be nice.

The last code I found and tried didn't store the starting folders on the spreadsheet. I just can't get it to drop the file and save it in the last folder I select with it.

 

[Micron]

What's up with the repetitive quoting & pic posting but no related commentary?
I understand new stuff is difficult for novices but IMO we should be progressing much better than we are. Here's what you must do if I'm to continue attempting to arrive at a solution:
1) enclose your code in code tags (click vba button on posting toolbar & paste in between the tags. Use proper indentation. See how much easier it is to read in post 7.
2) I need to know exactly what ranges your code needs to reference and what's in those cells. So far we've got cells in D, K, L and maybe more.
3) I need to know the starting folder path or at least where you're getting it from. I gather that is D1 and D3.

Describe what has to happen and when. Example based on what I think I know at this point:

1) When I click the button I want the dialog to open at the path stored in D1. I will choose a folder and click OK.
2) Then I want the range to be stored in that folder as a pdf.
3) I also want the same pdf to be stored in a folder whose complete path is stored in D3.

or is it 1) and 2) then
3) I want the fd to open again at the starting path that's stored in D3 and I will choose the folder to store the 2nd pdf in.
Or maybe something else?

All that might seem like a lot of work but I think you've already done more than that without achieving your goal.