VBA - Save As PDF

[Spaztic]

I'm working on a macro that would save my Excel workbook as a PDF.
I'm saving as pdf with some options (ignore print area, save entire workbook)...

This file will be used by many different users so the line "C:\Users\myname\OneDrive - Company\Desktop\folder\trial.pdf" probably won't work as it has my name entered and also the file name (currently 'trial') is not always the same. I'd like the saved pdf file name to be the same as the Excel file and stored in the same location as the Excel file.

Any help would be appreciated!

Sub SavePDF()

    ActiveWorkbook.Save
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\myname\OneDrive - Company\Desktop\folder\trial.pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=True, OpenAfterPublish:=False

    End Sub

 

[Micron]

Thisworkbook.Path will return the folder path where the workbook is located.
Thisworkbook.Name will return the name of the active wb but you probably want to drop the .xlsm or whatever the extension is.
Left(thisworkbook.Name,instr(thisworkbook.Name,".")-1) will drop the extension so that you can concatenate ".pdf"

If you assign the path and name to variables it would make code lines a bit shorter but it's not necessary. Note: the above assumes you don't have additional periods in file names. It used to drive me crazy as a coder when people put spaces and special characters in folder names because they just make things harder sometimes. Also, you could use Activeworkbook.Path but I don't think it's advisable if 2 or more wb's could be open at the same time, and one of those ends up being the active one.

 

[Micron]

I might look like this

Dim sPath As String, sName As String

sPath = ThisWorkbook.Path
sName = ThisWorkbook.Name
sName = Left(sName, InStrRev(sName, ".") - 1)

ThisWorkbook.Save
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sPath & "\" & sName & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False

 

[Spaztic]

Thanks! Worked perfectly!

 

[Micron]

You're welcome and thanks for the recognition. Do note what I mentioned about Activeworkbook vs Thisworkbook and consider which is right for your situation. I changed it in a couple of places but didn't try it in the export part. I forgot to see if it was an option there also.

 

[Spaztic]

You're welcome and thanks for the recognition. Do note what I mentioned about Activeworkbook vs Thisworkbook and consider which is right for your situation. I changed it in a couple of places but didn't try it in the export part. I forgot to see if it was an option there also.

I really appreciate it.

Do you know if there is an easy way to have a message box appear when the pdf file name already exists in the directory and it gives you an option whether you want to 'save over the existing file' or 'cancel'?

 

[Micron]

One way

Dim sPath As String, sName As String, sFind As String, sFound As String
Dim result As Integer

sPath = ThisWorkbook.Path
sName = ThisWorkbook.Name
sName = Left(sName, InStrRev(sName, ".") - 1)
sPath = sPath & "\" & sName & ".pdf" 'edit sPath
sFound = Dir(sPath) 'if sFound="" then file does not exist

If sFound <> "" Then 'if True, file exists
    result = MsgBox(sPath & " already exists." & vbCrLf & "Over-write this file?", vbYesNo, "FILE EXISTS")
    If result = vbNo Then Exit Sub
    ThisWorkbook.Save
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sPath, _
       Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
End If

If you don't want the full path in the message, swap sPath to sName. If this code causes other procedures to run (e.g. workbook BeforeSave) you might have issues.. I suggest you step through the code; once before a file is created and again to over-write that same file and watch what happens.

 

[Spaztic]

When I use this code, I get the error 'Bad File Name or Number'

 

[Micron]

IMO, always best to post your version to show your implementation of the code. Sometimes things get messed up in the copied/pasted version. Also possible that something about the file name or path is poorly done, such as containing characters that are not allowed. You might want to check that against the rules.

To see the directory path that is causing this, put this after ThisWorkbook.Save line:
debug.print sPath
Stop

then run it and check the output in the immediate window. Look for anything amiss. If it looks right, is there anything in the path string that violates the rules shown at the link I gave you? Can you post the output, or if it's not for public viewing consider sending the output to me in a pm.

EDIT -when code execution hits the stop line it will hang. You could terminate it with the reset button or menu item on the vb editor toolbar.

 

[Micron]

Here's another approach, using File Scripting Object which is a much more powerful and versatile tool than the Dir function.
Note - you must set a reference in the vbe. BTW, both codes work for me as expected; i.e. if file exists it prompts and either does or doesn't overwrite accordingly. If it doesn't exist, it just creates the pdf.

Sub SavePDF2()
Dim sPath As String, sName As String
Dim result As Integer
Dim fso As Object, f As Object

sPath = ThisWorkbook.Path
sName = ThisWorkbook.Name
sName = Left(sName, InStrRev(sName, ".") - 1)
sPath = sPath & "\" & sName & ".pdf" 'edit sPath
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
    If .FileExists(sPath) Then
        result = MsgBox(sPath & " already exists." & vbCrLf & "Over-write this file?", vbYesNo, "FILE EXISTS")
        If result = vbYes Then
            ThisWorkbook.Save
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sPath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
        End If
    End If
End With

Set fso = Nothing
Set f = Nothing

End Sub

EDIT - I tested a version that eliminates the With block and it works. So if you want to remove the With and End With lines you can use this instead:

    If fso.FileExists(sPath) Then
        result = MsgBox(sPath & " already exists." & vbCrLf & "Over-write this file?", vbYesNo, "FILE EXISTS")
        If result = vbYes Then
            ThisWorkbook.Save
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=sPath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
        End If
    End If