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.
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.