VBA to Save As PDF Tweak

[rodl66]

Hello,

I have the following code that does almost what I want it to except it won't save in the location I've specified, instead it prompts for you to search for the folder to save the file in. If possible, I'd like it to save where I thought I had it going to (C:\PIO\Daily Files\ECEAT\EntryCL\). I appreciate your time and expertise, I don't want the user to have to figure out where to save the file, I just want them to be able to click OK to save it.

Thank you.

Sub PDFActiveSheetCkIn()

'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant

On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "ddmmmyyyy\_hhmmss")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = "C:\PIO\Daily Files\ECEAT\EntryCL\"
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler

End Sub

 

[Candyman8019]

I would say replace this:

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = "C:\PIO\Daily Files\ECEAT\EntryCL\"
End If
strPath = strPath & "\"

with this:

strPath = "C:\PIO\Daily Files\ECEAT\EntryCL\"

 

[Candyman8019]

One other thing... using StrTime in your filename, you may want to change the backslash as that could make it look like the date would be a folder and the filename would then start with an _.

for example, change:
strTime = Format(Now(), "ddmmmyyyy\_hhmmss")

to:
strTime = Format(Now(), "ddmmmyyyy-hhmmss")

 

[rodl66]

I would say replace this:

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = "C:\PIO\Daily Files\ECEAT\EntryCL\"
End If
strPath = strPath & "\"

with this:

strPath = "C:\PIO\Daily Files\ECEAT\EntryCL\"

I appreciate the suggestion. It now opens a save window that is buried in my OneDrive folder and not the working folder like before.

 

[Candyman8019]

Also, remove this line:

strPath = strPath & "\"

This is essentially adding a double slash to your path.

 

[rodl66]

Also, remove this line:

strPath = strPath & "\"

This is essentially adding a double slash to your path.

Candyman,

Here's my modified code. When I click the button I assigned the macro to, instead of saving to "C:\PIO\Daily Files\ECEAT\EntryCL\", it opens a save as dialog box with my OneDrive\Documents folder.

Sub PDFActiveSheetCkIn()

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant

On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "ddmmmyyyy-hhmmss")

'get active workbook folder, if saved
strPath = "C:\PIO\Daily Files\ECEAT\EntryCL\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler

End Sub

 

[Candyman8019]

try changing this section as follows and see what path/filename shows:

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
msgbox strPathFile

We want to ensure it is displaying a valid path and filename.

 

[rodl66]

try changing this section as follows and see what path/filename shows:

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
msgbox strPathFile

We want to ensure it is displaying a valid path and filename

 

[rodl66]

I will try this in the morning, the file is on my work computer. Thank you.

 

[John_w]

When I click the button I assigned the macro to, instead of saving to "C:\PIO\Daily Files\ECEAT\EntryCL\", it opens a save as dialog box with my OneDrive\Documents folder.

Delete these lines and the corresponding End If:

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then