Macro- save as PDF to folder

[mtravis38]

Good morning,

I have a macro (see below), part of which saves the Excel file to PDF and names the file. Unfortunately, it also saves the file to a destination folder, and I'm not sure why.

What I would like to do is save the PDF to the same folder as the Excel file from which the PDF was created. This file location will not always be the same, so I can't just insert a specific file path. Any help would be appreciated.

The bolded part of the macro saves the file. Even though the file path is not explicitly stated, it always saves to my "W" drive.

Also note that none of the "called" macros have anything to do with the file save.

Sub Approval_xxxx()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
'<o></o>
' Approval_xxxx Macro<o></o>
'<o></o>
ActiveSheet.Unprotect<o></o>
Application.ScreenUpdating = False<o></o>
Dim MyPassword<o></o>
MyPassword = InputBox("Please enter password", "Password Prompt", "********")<o></o>
If MyPassword = "xxxx" Then<o></o>
MsgBox "Access Granted", vbInformation, "Access"<o></o>
Dim objSheet As Worksheet<o></o>
Range("V8").Select<o></o>
ActiveCell.FormulaR1C1 = "=TODAY()"<o></o>
Range("V8").Select<o></o>
Selection.Copy<o></o>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _<o></o>
:=False, Transpose:=False<o></o>
Range("E39").Select<o></o>
ActiveCell.FormulaR1C1 = "xxxx"<o></o>
ActiveSheet.Protect DrawingObjects:=False<o></o>
Call JOC_Sig<o></o>
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("a48").Text, Quality:=xlQualityStandard, _<o></o>
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _<o></o>
True<o></o>
Worksheets("A-1 COVER").Select<o></o>
Range("D6").Select<o></o>
ActiveCell.FormulaR1C1 = "xxxx"<o></o>
Range("F6").Select<o></o>
ActiveCell.FormulaR1C1 = "R"<o></o>
Range("M6").Select<o></o>
ActiveCell.FormulaR1C1 = "=TODAY()"<o></o>
Range("m6").Select<o></o>
Selection.Copy<o></o>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _<o></o>
:=False, Transpose:=False<o></o>
Range("M7").Select<o></o>
ActiveWindow.SmallScroll Down:=39<o></o>
Range("F58").Select<o></o>
ActiveCell.FormulaR1C1 = "=TODAY()"<o></o>
Range("f58").Select<o></o>
Selection.Copy<o></o>
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _<o></o>
:=False, Transpose:=False<o></o>
Range("J58").Select<o></o>
ActiveCell.FormulaR1C1 = "xxx"<o></o>
Range("K59").Select<o></o>
ActiveCell.FormulaR1C1 = "R"<o></o>
Range("M59").Select<o></o>
ActiveCell.FormulaR1C1 = "xxx"<o></o>
Range("F62").Select<o></o>
ActiveCell.FormulaR1C1 = "R"<o></o>
Call Hide_Blank_Comments<o></o>
Range("B78").Select<o></o>
ActiveCell.FormulaR1C1 = "xxxx"<o></o>
Else<o></o>
MsgBox "Access denied", vbCritical, "Error"<o></o>
Exit Sub<o></o>
End If<o></o>
Application.ScreenUpdating = True<o></o>
End Sub<o></o>

 

[Andrew Poulsom]

Try:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=[B][COLOR=red]ActiveWorkbook.Path & Application.PathSeparator &[/COLOR][/B] Range("a48").Text, Quality:=xlQualityStandard, _<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _<o:p></o:p>
True<o:p></o:p>

 

[mtravis38]

That works perfectly. Thanks for your assistance.