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!
Related
The following code loops through All files in a specified folder, formats each file, and saves it as a PDF in the same folder.
The code runs fine but there are 2 issues:
1)if there are any files in the folder that are already pdf,s it will open in and mess it up. How can I make this so it only opens the excel files in the folder and not PDF files?
2)if I run it twice it works but it just saves over files if the filename already exists. How can I make I so if when it saves it and the file name already exists it saves it as a new file like filename-b, filename-c filename-d, filename-f ect?
Sub File_Loop_Example()
Dim MyFolder As String, MyFile As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.clear
End With
MyFile = Dir(MyFolder & "\", vbReadOnly)
Do While MyFile <> ""
DoEvents
On Error GoTo 0
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
Application.Run "PERSONAL.XLSB!TTDA"
ChDir MyFolder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
MyFolder & "\" & MyFile, Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
0
Workbooks(MyFile).Close SaveChanges:=False
MyFile = Dir
Loop
End Sub
Try replacing of
MyFile = Dir(MyFolder & "\", vbReadOnly)
with
MyFile = Dir(MyFolder & "\" & "*.xlsx")
In this way, the code will open only .xlsx files.
Or you can let your code like it is, but filter the files to be open using the next function which retrieves the file extension:
Private Function GetExt(fileName As String) As String
GetExt = Split(fileName, ".")(UBound(Split(fileName, ".")))
End Function
The function can be called just before the workbook opening. Your loop will become something like this:
Do While MyFile <> ""
DoEvents
If GetExt(MyFile) = "xlsx" or GetExt(MyFile) = "xlsm" then
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
Application.Run "PERSONAL.XLSB!TTDA"
ChDir MyFolder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
MyFolder & "\" & MyFile, Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
OpenAfterPublish:=True
Workbooks(MyFile).Close SaveChanges:=False
End if
MyFile = Dir
Loop
For the next issue, use please:
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(MyFolder & "\" & MyFile & ".pdf") Then
If fso.FileExists(MyFolder & "\" & MyFile & "_b.pdf") Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
MyFolder & "\" & MyFile & "_a", Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
MyFolder & "\" & MyFile & "_b", Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
End If
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
MyFolder & "\" & MyFile, Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False
End If
this code used to run perfectly now is having time error 53, file not found. Not sure what is wrong
Sub printxxx()
' Print_quote XXX Macro
ActiveSheet.PageSetup.Orientation = xlLandscape
Worksheets("Quote").PageSetup.PrintArea = "$H$6:$Z$133"
strFile = ThisWorkbook.Path & "\" & strFile
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & CreateObject("Scripting.FileSystemObject").GetFile(ThisWorkbook.FullName).ParentFolder.Name & " XXXQuote ", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
ActiveSheet.PageSetup.Orientation = xlPortrait
End Sub
The following code runs perfectly from my desktop or other folder paths. Except in a shared drive that keeps giving me a run-time error 5
The error appears on the following line
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Cell & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
The full code
Private Sub CommandButton1_Click()
Dim ReportSheet As Worksheet
If ThisWorkbook.Worksheets("Cover Page").Range("F11").Value <> vbNullString Then
FormatDate = Format(Sheets("Cover Page").Range("F11"), "MMMM DD, YYYY")
End If
Cell = "Statements - " & FormatDate
ThisWorkbook.Sheets(Array("Sheet1", " Sheet2", " Sheet3”).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Cell & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Application.Goto Reference:=Sheets("X").Range("A1")
End Sub
I am trying to save my Excel file as a PDF but with custom file name.
I would only add a piece to the prompted filename from the Excel file.
According to the queries here:
Save excel as PDF in current folder using current workbook name
Save excel as PDF in current folder using current workbook name
My code looks as follows:
Sub DPPtoPDF()
ThisWorkbook.Sheets.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & ThisWorkbook.Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Sheets("Frontsheet").Select
End Sub
From this code we know the PDF filename will be the Excel filename.
I tried something like this:
ThisWorkbook.Sheets.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= &fName $ "-Route-Aprooval.pdf" _
ThisWorkbook.Path & "\" & ThisWorkbook.Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
I get an error as per in the picture below.
I can see something is up, as my code is turning red.
The code:
ThisWorkbook.Sheets.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
" &fName $ "-Route-Aprooval.pdf""
ThisWorkbook.Path & "\" & ThisWorkbook.Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
also doesn't work.
Any code behind the Filename:= destroys whole code.
I want to keep the name as in Excel, but add another part of the name after dash (per the image above).
Where should I place my new output filename?
Try the code below.
Sub DPPtoPDF()
Dim Custom_Name as string
ThisWorkbook.Sheets.Select
Custom_Name= ThisWorkbook.Name & "-route approval" & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Custom_Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Sheets("Frontsheet").Select
End Sub
I have this macro that saves to a defined path which is not useful since multiple people will be using the file.
Sub SavetoPdf()
'
' SavetoPdf Macro
' To Save to PDF Details
'
' Keyboard Shortcut: Ctrl+s
'
Range("E31:I54").Select
Application.CutCopyMode = False
ChDir "/Users/Me/Desktop/"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"/Users/Me/Desktop/" & Range("G41").Value & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
I thought to save to ThisWorkbook.Path and modified the above.
Sub SavetoPdf()
' Saves active sheet as PDF file.
Dim Name As String
Name = ThisWorkbook.Path & "/" & Range("G41").Value & ".pdf"
Range("E31:I54").Select
Application.CutCopyMode = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Name, _
Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
I am on a Mac.
I get
Error on Printing
and the debugger highlights this code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Name, _
Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
You title reads that you want to PDF a "Range" of cells. Is that what is not working for you?
Sub SavetoPdf()
' Saves active sheet as PDF file.
Dim Name As String
Name = ThisWorkbook.Path & "/" & Range("G41").Value & ".pdf"
Range("E31:I54").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name, _
Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
Modified #Davesexel code: Tested on mock data and saved no problem.
Dim rng As Range
Dim Name As String
Set rng = Worksheets("Sheet1").Range("G41") 'Change worksheet to your needs
Name = rng.Value
Range("E31:I54").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "/" & Name & ".pdf", _
Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False