Below code works fine until generate a filename. It picks up the correct folder location, but the file name is blank.
If I choose location somewhere on my local machine, the filename appears then. Could you advise me what should I do differently, please?
Private Sub CBSaveasPDF_Click()
Dim FileAndLocation As Variant
Dim strPathLocation As String
Dim strFilename As String
Dim strPathFile As String
strPathLocation = "http://teams.xxx.intranet/sites/bipm/test/test/test/test/test/"
strFilename = Me.Range("D8") & " -" & Me.Range("D7") & " -" & Me.Range("J7") & " " & Me.Range("B3")
strPathFile = strPathLocation & strFilename
FileAndLocation = Application.GetSaveAsFilename _
(InitialFileName:=strPathLocation & strFilename, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If FileAndLocation = "False" Then
MsgBox ("Document not saved")
Exit Sub
End If
Me.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Related
I need to export excel sheet as PDF named with String and Cell Value for Example XXXY - Cell Value
Note: i do not need codes that uses path location for the saving file
I tried the following code
Sub IVI_Formatting_Export_Two_PDF ()
Dim strFilename As String
Dim srn As String Dim SWPDF As Worksheet
Set SWPDF = ThisWorkbook.Sheets ("BSS CPES MainPage")
srn = "CPE Main-Page"
strFilename = SWPDF.Range ("F7").Value
Create File name with Warehouse Name
Export2PDF
SWPDF.ExportAsFixedFormat
Type:=xlTypePDF,
Filename:=strFilename & srn,
Quality:=xl QualityStandard,
IncludeDocProperties:=False,
IgnorePrintAreas:=False,
From:=1,
To:=1,
OpenAfterPublish:=True
End Sub
You must specify a path to export PDF. Without path where it will be saved? You can use variable to specify path. Currently I have used same as file path. Your problem was in filename parameter. Try below sub.
Sub IVI_Formatting_Export_Two_PDF()
Dim strFilename As String
Dim srn As String
Dim SWPDF As Worksheet
Set SWPDF = ThisWorkbook.Sheets("BSS CPES MainPage")
srn = "CPE Main-Page"
strFilename = SWPDF.Range("F7").Value
'Create File name with Warehouse Name
'Export2PDF
SWPDF.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & strFilename & "_" & srn & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
From:=1, _
To:=1, _
OpenAfterPublish:=True
'Clear memory
Set SWPDF = Nothing
End Sub
Here Filename:=ThisWorkbook.Path & "\" & strFilename & "_" & srn & ".pdf" will export the PDF to same folder where your workbook is located. Also you must include .pdf extension to export excel sheet as pdf.
I am trying to convert an excel sheet to pdf than save it to a folder on my desktop, however, I keep getting a run time error of 1004 - application-defined or object defined error. I have placed the code below. Can anyone please assist?
Private Sub pdfAlternate()
Dim strPathLocation As String
Dim strFilename As String
Dim strPathFile As String
Dim fileSaveName As String
Dim fileSavePath As String
Dim pdfOpenAfterPublish As Boolean
strPathLocation = Worksheets("Form").Range("C11").Value
strFilename = Worksheets("Form").Range("L11").Value
fileSaveName = strPathLocation & "_" & strFilename
fileSavePath = "C:\Users\fou55227\Desktop\BMW" & "\" & fileSaveName & "_" & Format(Date, "MM.DD.YYYY") & ".pdf"
ActiveWorkbook.Sheets("Form").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fileSavePath _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Debug.Print fileSaveName
Debug.Print fileSavePath
End Sub
I am currently using VBA to generate an automated letter for me. Using the below:
Sub CreatePDF()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String
Set wSheet = ActiveSheet
sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile
vFile = Application.GetSaveAsFilename _
(InitialFileName:=sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If vFile <> "False" Then
wSheet.Range("P1:Y336").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
End If
End Sub
Wondering if there is a way to make the generated file name of the PDF to correspond to specific cell inputs (in the sheet, they are pulled in by vlookup). Ideally, have the file be: C7_C8.pdf
not sure if you mean the cell address, or what's inside the cell.
But i just hardcode the "sFile" to a specific cell in my worksheet :
sFile = Workbooks("blabla.xlsb").Sheets("Sheet1").Range("AE14")
into the below, notice the "" &
vFile = Application.GetSaveAsFilename _
(InitialFileName:="" & sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
so whatever cell AE14 contains it will be passed as the PDF filename in the Save As prompt. hope it helps!
I have the following macro to create a folder within the folder where the Excel file is:
Sub Folder_Test()
If Dir(ThisWorkbook.Path & "\" & "Folder_01", vbDirectory) = "Folder_01" Then
MsgBox "Folder already exists!"
Else
MkDir Application.ThisWorkbook.Path & "\" & "Folder_01"
End If
End Sub
And I have the following macro to create a PDF file:
Sub Button_PDF_200()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & "test.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Now I want that the PDF file which is created in the second macro will be saved in the folder which is created in the first macro.
Do you have any idea how I can do this?
Maybe just that?
Sub Button_PDF_200()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & "Folder_01" & "\" & "test.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
That is changing the Filename argument within the sub Button_PDF_200 from
ThisWorkbook.Path & "\" & "test.pdf"
to
ThisWorkbook.Path & "\" & "Folder_01" & "\" & "test.pdf"
..
Hi Michi,
also you can try something like this:
pdfName = ActiveSheet.Range("T1")
ChDir "C:\Temp\" 'This is where youo set a defult file path.
fileSaveName = Application.GetSaveAsFilename(pdfName, _
fileFilter:="PDF Files (*.pdf), *.pdf")
If fileSaveName <> False Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
fileSaveName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End If
MsgBox "File Saved to" & " " & fileSaveName
Have fun!
I have a code that prints a selected area in a worksheet to PDF and allows user to select folder and input file name.
There are two things I want to do though:
Is there a way that the PDF file can create a folder on the users desktop and save the file with a file name based on specific cells in the sheet?
If multiple copies of the same sheet are saved/printed to PDF can each copy have a number eg. 2, 3 in the filename based on the copy number?**
Here is the code I have so far:
Sub PrintRentalForm()
Dim filename As String
Worksheets("Rental").Activate
filename = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and Filename to save")
If filename <> "False" Then
With ActiveWorkbook
.Worksheets("Rental").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With
End If
filename = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and Filename to save")
If filename <> "False" Then
With ActiveWorkbook
.Worksheets("RentalCalcs").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End If
End Sub`
UPDATE:
I have changed the code and references and it now works. I have linked the code to a commandbutton on the Rental Sheet -
Private Sub CommandButton1_Click()
Dim filenamerental As String
Dim filenamerentalcalcs As String
Dim x As Integer
x = Range("C12").Value
Range("C12").Value = x + 1
Worksheets("Rental").Activate
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
filenamerental = Path & "\" & Sheets("Rental").Range("O1")
'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Rental").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filenamerental, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Worksheets("RentalCalcs").Activate
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
filenamerentalcalcs = Path & "\" & Sheets("RentalCalcs").Range("O1")
'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("RentalCalcs").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filenamerentalcalcs, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Worksheets("Rental").Activate
Range("D4:E4").Select
End Sub
Hopefully this is self explanatory enough. Use the comments in the code to help understand what is happening. Pass a single cell to this function. The value of that cell will be the base file name. If the cell contains "AwesomeData" then we will try and create a file in the current users desktop called AwesomeData.pdf. If that already exists then try AwesomeData2.pdf and so on. In your code you could just replace the lines filename = Application..... with filename = GetFileName(Range("A1"))
Function GetFileName(rngNamedCell As Range) As String
Dim strSaveDirectory As String: strSaveDirectory = ""
Dim strFileName As String: strFileName = ""
Dim strTestPath As String: strTestPath = ""
Dim strFileBaseName As String: strFileBaseName = ""
Dim strFilePath As String: strFilePath = ""
Dim intFileCounterIndex As Integer: intFileCounterIndex = 1
' Get the users desktop directory.
strSaveDirectory = Environ("USERPROFILE") & "\Desktop\"
Debug.Print "Saving to: " & strSaveDirectory
' Base file name
strFileBaseName = Trim(rngNamedCell.Value)
Debug.Print "File Name will contain: " & strFileBaseName
' Loop until we find a free file number
Do
If intFileCounterIndex > 1 Then
' Build test path base on current counter exists.
strTestPath = strSaveDirectory & strFileBaseName & Trim(Str(intFileCounterIndex)) & ".pdf"
Else
' Build test path base just on base name to see if it exists.
strTestPath = strSaveDirectory & strFileBaseName & ".pdf"
End If
If (Dir(strTestPath) = "") Then
' This file path does not currently exist. Use that.
strFileName = strTestPath
Else
' Increase the counter as we have not found a free file yet.
intFileCounterIndex = intFileCounterIndex + 1
End If
Loop Until strFileName <> ""
' Found useable filename
Debug.Print "Free file name: " & strFileName
GetFileName = strFileName
End Function
The debug lines will help you figure out what is happening if you need to step through the code. Remove them as you see fit. I went a little crazy with the variables but it was to make this as clear as possible.
In Action
My cell O1 contained the string "FileName" without the quotes. Used this sub to call my function and it saved a file.
Sub Testing()
Dim filename As String: filename = GetFileName(Range("o1"))
ActiveWorkbook.Worksheets("Sheet1").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Where is your code located in reference to everything else? Perhaps you need to make a module if you have not already and move your existing code into there.