PDA

View Full Version : [SOLVED] Help with SaveAs PDF



DragonWood
02-09-2017, 11:46 AM
Greetings & Salutations,


This is a weird one (for me anyway).


The procedure sounds simple enough:
1. Import the information from the non-macro enabled workbook the customer filled out.
2. SaveAs this workbook under a new name and in a new folder location based on the imported information.
3. Save a copy of the information imported as a PDF in that same folder.


Everything works great, up to the last part of step 3, the “in that same folder” part.


For some reason, it keeps saving the PDF in whatever folder the non-macro enabled workbook is in.


Here are the code snippets used, in the order they are used.


1. Import the information from the non-macro enabled workbook the customer filled out.


Public Sub NewCertificationQuote(control As IRibbonControl)
'Imports the data from the Customer filled Certification Quote Template.

Dim wbMaster As Workbook, wbCustomer As Workbook
Dim wsImport As Worksheet, ws As Worksheet
Dim aCustomers As Variant
Dim iCustomer As Long

Call CertifyImportClear
Call HexCertQuoteClear

Set wbMaster = ThisWorkbook
Set wsImport = wbMaster.Worksheets("CertifyImport")

'ask for customer wb name or names
aCustomers = Application.GetOpenFilename("*.xls?, Customer Files", , "Select Customer Workbook(s)", , True)

If Not IsArray(aCustomers) Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
For iCustomer = LBound(aCustomers) To UBound(aCustomers)

'open each wb
Workbooks.Open Filename:=aCustomers(iCustomer)
Set wbCustomer = ActiveWorkbook

'look for special marker on each sheet (one / WB)
For Each ws In wbCustomer.Worksheets
If ws.Cells(1, 1).Value = "CompanyName" Then
ws.Cells(1, 1).CurrentRegion.Columns(2).Copy
wbMaster.Activate
wsImport.Visible = True
wsImport.Select
wsImport.Cells(wsImport.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
wsImport.Visible = False

Exit For
End If

Next

wbCustomer.Close (False)

Next iCustomer

Call UnhideAll
Call HideMe


Application.Goto Sheets("Certification Quote Template").Range("A1")

Call HexCertQuoteFill
Call HexCertQuoteCleanUp
Call HexCertServiceDetails

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub



2. SaveAs this workbook under a new name and in a new folder location based on the imported information.


Public Function SaveFileAs()
'Saves the file to a set folder path based on the cell values in the Service Details section of the Lists page.


'Declare the Variables for Saving the File
Dim custSaveName As String
Dim ipsnSaveName As String
Dim citySaveName As String
Dim typeSaveName As String
Dim fileSaveName As String
Dim ponumSaveName As String


'Declare the Variables for the Directory Path
Dim fileRootPath As String
Dim fileSavePath As String
Dim dirDepth As Long
Dim nextDir As Long
Dim tempDir As String
Dim x As Long


'Declare the Varialbles for the Input Boxes
Dim custInput As String
Dim ipsnInput As String
Dim cityInput As String


'Declare the Varibles for the Message Boxes
Dim msgCreate As String
Dim msgStyle As String
Dim msgTitle As String




'Unhide the sheets if still hidden

Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = True
Next ws
Application.DisplayAlerts = True


'Make the Lists page the focus point

Application.Goto Sheets("Lists").Range("A1"), True

'Check the Company Name, IPSN Name, and City Name fields for content. If there, use the content, if not provide an input box for entering the data.

With Sheets("Lists")
If .Range("J11").Value = "" Then
.Range("J11").Select
custInput = InputBox("Please enter the Customer Name.", "Customer Name")
ActiveCell.FormulaR1C1 = custInput
End If
If .Range("J5").Value = "" Then
.Range("J5").Select
ipsnInput = InputBox("Please fill in the CMM Serial Number.", "CMM Serial Number")
ActiveCell.FormulaR1C1 = ipsnInput
End If
If .Range("J13").Value = "" Then
.Range("J13").Select
cityInput = InputBox("Please fill in the Customer City.", "Customer City")
ActiveCell.FormulaR1C1 = cityInput
End If

ponumSaveName = CleanFileName(.Range("I3").Value)
citySaveName = CleanFileName(.Range("J13").Value)
ipsnSaveName = CleanFileName(.Range("J5").Value)
custSaveName = CleanFileName(.Range("J11").Value)
typeSaveName = CleanFileName(.Range("J3").Value)
End With

'Set the Root Path

fileRootPath = "L:\Service\Private\CUSTOMER PO\"


'Set the File Save Name
fileSaveName = custSaveName & " - IP " & ipsnSaveName & " - " & typeSaveName & " - " & ponumSaveName & ".xlsm"

'Set the sub paths

fileSavePath = fileRootPath & custSaveName & "\" & citySaveName & "\" & "IP " & ipsnSaveName & "\" & "PO# " & ponumSaveName & "\"

'Check for directory name, use it if there, create it if not

If Dir(fileSavePath, vbDirectory) = "" Then
dirDepth = Len(fileSavePath) - Len(Replace(fileSavePath, "\", ""))
nextDir = InStr(fileSavePath, "\")
For x = 1 To dirDepth - 1
nextDir = InStr(nextDir + 1, fileSavePath, "\")
tempDir = Left(fileSavePath, nextDir)
If Dir(tempDir, vbDirectory) = "" Then MkDir tempDir
Next x
End If

'Save the workbook under the new directory and name


ActiveWorkbook.SaveAs Filename:=fileSavePath & fileSaveName

Application.Goto Sheets("Instructions").Range("A1"), True

Call HideMe

End Function



3. Save a copy of the information imported as a PDF in that same folder.


Public Sub SaveCertificationQuote(control As IRibbonControl)
'Saves the Certification Quote Template page in PDF Format.


Dim strCertPath As String
Dim strCertName As String

strCertPath = ThisWorkbook.Path
strCertName = ThisWorkbook.Name

If Dir(strCertPath, vbDirectory) = "" Then
MkDir (strCertPath)
End If



'Save the Certification Quote Template page as a PDF
Application.Goto Sheets("Certification Quote Template").Range("A1"), True
With Sheets("Certification Quote Template")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="CERTIFICATION QUOTE TEMPLATE - " & strCertName & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With

End Sub



Like I said, everything works fine except it’s not saving the PDF in the correct location. :think:


I would appreciate some help.


Thank you.

Kenneth Hobs
02-09-2017, 08:46 PM
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strCertPath & "\" & _
"CERTIFICATION QUOTE TEMPLATE - " & strCertName & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

DragonWood
02-10-2017, 11:02 AM
Thank you. That worked.