Print to PDF Macro using Custom File and Folder Name

[justanotheruser]

Hi all,

I've been reading around on the website, and all the threads that I have found have been very useful, but it seems that no-one has asked how to create a macro that allows a custom PDF file name from a cell and a customer folder name, from another cell.

I'm running Excel 2010 on Windows 7 and have two options for my printing.

a) Use CutePDF writer as a printer to save as a PDF (although from what I've read, its not easy to insert a file name there).

b) Use the in-built save as PDF now in Office 2007/Office 2010 to try this.

From what I can tell (I'm new to VBA, so I might be wrong) it maybe easier to use the latter option for my problem.

Basically, the reason that I need a custom folder name is because the sheet I am saving to PDF needs to be put in a folder according to the month it was created in. The code I have tried so far is:

Sub Make_PDF()
' Create and save .pdf
Dim pdfName As String
pdfName = Range("B7").Text
FolderName = Range("H17").Text
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="D:\Invoices\" + FolderName + pdfName + ".pdf" _
, Quality:=xlQualityMedium, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Cell B7 is an alpha-numeric code such as C0156-6302K, which seems to work fine.

Cell H17 contains the formula =NOW() which has been custom formatted to "mmm yy" - so that currently it shows "Aug 10". I have two problems:

1. When I save it currently, the file saves in D:\Invoices\ under the file name: "Aug 10C0156-6302K.pdf" as an example.
   • I would like it to be saved under D:\Invoices\Aug 10\ under the name "C0156-6302K.pdf".
2. Also, if possible I would like the user to be able to see a confirmation screen (the prompt window) so that they can confirm the file save location.

The second option isn't a must, but if its possible I'd really appreciate it.

Thank you in advance for your help!

 

[justanotheruser]

OK - that seems to be working now, thank you again.

I've noticed a slight problem with the code. By mistake, I deleted the "Aug 10" folder from D:\Invoice\ - when I then ran the code I got the error message:

Run time error '1004': Document not saved. The document may be open, or an error may have been encountered when saving.

and

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FullName _
, Quality:=xlQualityMedium, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

From the code was highlighted.

I presume this is because the code doesn't actually create the folder, just relies on it existing. Is there a way that you can get the code to check if the folder exists, if it does, continue, otherwise create the folder with the folder name, and then continue?

My code so far is now:

Sub Make_PDF()
' Create and save .pdf
Dim pdfName As String, FolderName As String, FullName As String
pdfName = Range("B7").Text
FolderName = Range("H17").Text
FullName = "D:\Invoices\" & FolderName & "\" & pdfName & ".pdf"
If MsgBox("Please confirm that name and location is correct: " & FullName & ".  -  " & " Is it correct?", vbYesNo + vbQuestion, "Confirm File Name and Location") = vbNo Then Exit Sub
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FullName _
, Quality:=xlQualityMedium, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
YesNo = MsgBox("Would you like to open the folder where the invoice was saved?" _
, vbYesNo + vbQuestion, "Open Folder?")
Select Case YesNo
Case vbYes
myval = Shell("explorer D:\Invoices\" & FolderName, 1)
Case vbNo
End Select
End Sub

Thanks again for you help...

 

[VoG]

Try

Sub Make_PDF()
' Create and save .pdf
Dim pdfName As String, FolderName As String, FullName As String
pdfName = Range("B7").Text
FolderName = Range("H17").Text
If Not DirExists("D:\Invoices\" & FolderName) Then MkDir "D:\Invoices\" & FolderName
FullName = "D:\Invoices\" & FolderName & "\" & pdfName & ".pdf"
If MsgBox("Please confirm that name and location is correct: " & FullName & ".  -  " & " Is it correct?", vbYesNo + vbQuestion, "Confirm File Name and Location") = vbNo Then Exit Sub
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName _
, Quality:=xlQualityMedium, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
YesNo = MsgBox("Would you like to open the folder where the invoice was saved?" _
, vbYesNo + vbQuestion, "Open Folder?")
Select Case YesNo
Case vbYes
myval = Shell("explorer D:\Invoices\" & FolderName, 1)
Case vbNo
End Select
End Sub


Function DirExists(sSDirectory As String) As Boolean
If Dir(sSDirectory, vbDirectory) <> "" Then DirExists = True
End Function

 

[justanotheruser]

Perfect.

One last question (for now at least):

I have a shape in one sheet, Sheet 1 for the Invoice - I have added text to this shape such as special order instructinos. On Sheet 2, for the delivery note, I would like to make that shape have the same information in it as Sheet 1, so that if I change something on Sheet 1, it automatically updates on Sheet 2.

Is this possible on Excel 2010?

Thanks.

 

[VoG]

Try like this

Sheets("Sheet2").Shapes("TextBox 1").TextFrame.Characters.Text = Sheets("Sheet1").Shapes("TextBox 1").TextFrame.Characters.Text

 

[justanotheruser]

Try like this

Sheets("Sheet2").Shapes("TextBox 1").TextFrame.Characters.Text = Sheets("Sheet1").Shapes("TextBox 1").TextFrame.Characters.Text

I'm not sure where to put this code - I've basically created rounded rectangles, the one on Sheet 1 is called TextBox 1, the one on Sheet 2 is TextBox 2.

 

[VoG]

Try

Sub Make_PDF()
' Create and save .pdf
Dim pdfName As String, FolderName As String, FullName As String
Sheets("Sheet2").Shapes("TextBox 2").TextFrame.Characters.Text = Sheets("Sheet1").Shapes("TextBox 1").TextFrame.Characters.Text
pdfName = Range("B7").Text
FolderName = Range("H17").Text
If Not DirExists("D:\Invoices\" & FolderName) Then MkDir "D:\Invoices\" & FolderName
FullName = "D:\Invoices\" & FolderName & "\" & pdfName & ".pdf"
If MsgBox("Please confirm that name and location is correct: " & FullName & ".  -  " & " Is it correct?", vbYesNo + vbQuestion, "Confirm File Name and Location") = vbNo Then Exit Sub
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName _
, Quality:=xlQualityMedium, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
YesNo = MsgBox("Would you like to open the folder where the invoice was saved?" _
, vbYesNo + vbQuestion, "Open Folder?")
Select Case YesNo
Case vbYes
myval = Shell("explorer D:\Invoices\" & FolderName, 1)
Case vbNo
End Select
End Sub


Function DirExists(sSDirectory As String) As Boolean
If Dir(sSDirectory, vbDirectory) <> "" Then DirExists = True
End Function

 

[justanotheruser]

OK, that seems to work - however, if I want to do this with Sheet 1 copies to Sheet 2, and then Sheet 3 copies to Sheet 4, what would the code be that I need?

<CODE>Sheets("Sheet2").Shapes("TextBox 2").TextFrame.Characters.Text = Sheets("Sheet1").Shapes("TextBox 1").TextFrame.Characters.Text & Sheets("Sheet4").Shapes("TextBox 2").TextFrame.Characters.Text = Sheets("Sheet3").Shapes("TextBox 1").TextFrame.Characters.Text</CODE>

Is what I tried - but the shape from Sheet 3 doesn't copy to Sheet 4 - unless all the shapes need to have different names (i.e. TextBox 1, TextBox 2, TextBox 3 etc.)?

 

[VoG]

No, you can't do it like that. You'll need a separate line of code to change each shape's text.

 

[justanotheruser]

Sheets("Sheet2").Shapes("TextBox 2").TextFrame.Characters.Text = Sheets("Sheet1").Shapes("TextBox 1").TextFrame.Characters.Text
Sheets("Sheet4").Shapes("TextBox 2").TextFrame.Characters.Text = Sheets("Sheet3").Shapes("TextBox 1").TextFrame.Characters.Text

Gives a runtime error 9 - Subscript out of range.

 

[VoG]

That error means that either one of the sheets doesn't exist or one or more shape names doesn't exist. You'll need to check the shape names in particular.