Printing Function Stopped working

[spongebob]

Hello All,

I have a function which was custom made a long time ago and has been running great for years. Suddenly, the printing aspect stops in the middle and gives the error:
Run-time error '1004';
Document not saved. the document may not be open, or an error may have been encountered when saving.

The role of the function is to print tabs from within a workbook, this will print out page 1 of each tab, and save to PDF all the pages on the tab.
This funciton also has has an exclude list for what not to print. And last has a target destination folder value in a cell. ( this does start off working)
Lastly there is a target directory to right the P
Stepping through the debug doesn't give me enough direction.

Not sure if maybe something application wise changed, but not finding data or a tab being respsonsible.

Any suggestions appreciated.

Option Explicit
'Customized solution written by Excel Guru; reach out to xl2vba@gmail.com for any support or assistance
Sub Process()
Dim j As Long, k As Long, l As Long
Dim timestart As String
timestart = Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
'Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For j = 2 To LastRow(Sheets("Mapping_DB"), "A")
If IsError(Sheets("Mapping_DB").Cells(j, 1).Value) = True Then
    Sheets("Mapping_DB").Cells(j, 3).Value = "Error"
ElseIf Sheets("Mapping_DB").Cells(j, 1).Value <> "" Then
    If WorksheetExists(Sheets("Mapping_DB").Cells(j, 2).Value) = True Then
    'On Error Resume Next
        Call PopulateNow(Sheets("IN"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "Incoming", 23)
        Call PopulateNow(Sheets("Out"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "Outgoing", 24)
        Call PopulateNow(Sheets("Int"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "LD", 24, "L")
        Call PopulateNow(Sheets("Toll"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "TollFree", 24, "T")
        Call PopulateNow(Sheets("FAX"), Sheets("" & Sheets("Mapping_DB").Cells(j, 2).Value), "" & Sheets("Mapping_DB").Cells(j, 1).Value, "Fax", 25)
    'On Error GoTo 0
    Else
        Sheets("Mapping_DB").Cells(j, 3).Value = "Check"
    End If
End If
Next j
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
MsgBox "Done, started at " & timestart & vbCrLf & "Completed at " & Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
End Sub
Private Sub PopulateNow(wsSource As Worksheet, wsTarget As Worksheet, SearchString As String, Marker As String, RowNumber As Long, Optional FormulaIndicator As String)
Dim Rng As Range
Dim rw As Long, GapRow As Long, OrigGapRow As Long
If FormulaIndicator = "T" Then
    GapRow = 2
    OrigGapRow = 2
Else
    GapRow = 3
    OrigGapRow = 3
End If
If wsTarget.Cells(wsTarget.Range(Marker).Row + GapRow, 1).Value <> "" Then GapRow = wsTarget.Range("A" & wsTarget.Range(Marker).Row + GapRow).End(xlDown).Row + 1 - wsTarget.Range(Marker).Row
wsSource.UsedRange.AutoFilter
wsSource.UsedRange.AutoFilter Field:=9, Criteria1:="=" & SearchString
Set Rng = wsSource.Range("A2", wsSource.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Rng.Cells.Count > 1 Then
    wsTarget.Activate
    wsTarget.Rows("" & wsTarget.Range(Marker).Row + GapRow & ":" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count - 1).Select
    Selection.EntireRow.Insert shift:=xlDown
    wsSource.Range("A2", wsSource.Range("G" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
    wsTarget.Activate
    Range(Marker).Offset(GapRow, 0).PasteSpecial xlPasteValuesAndNumberFormats
    For rw = (wsTarget.Range(Marker).Row + GapRow) To (wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count - 1)
        If FormulaIndicator = "L" Then
            Range("H" & rw).Formula = "=IF($F" & rw & "<$C$" & RowNumber & ",(D" & rw & "/60)*($C$" & RowNumber & "*1.3),(D" & rw & "/60)*(($F" & rw & "*$M$4) +F" & rw & "))"
        ElseIf FormulaIndicator = "T" Then
            Range("H" & rw).Formula = "=IF(E" & rw & "=""Toll-Free:Canada"",D" & rw & "/60*($M$6),IF(E" & rw & "=""Toll-Free:Alaska"",D" & rw & "/60*($M$7),IF(E" & rw & "=""Toll-Free:Puerto Rico"",D" & rw & "/60*($M$8),D" & rw & "/60*($M$5))))"
        Else
            Range("H" & rw).Formula = "=D" & rw & "/60*$C$" & RowNumber
        End If
    Next rw
    'Check if more than 1 blank rows are there below & delete them
    If wsTarget.Range("A" & (wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count) + 1).Value = "" Then
        Rows("" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count & ":" & Range("A" & (wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count)).End(xlDown).Row - 2).Select
        Selection.EntireRow.Delete
    End If
    Rows(wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count).Copy
    Range("A" & wsTarget.Range(Marker).Row + GapRow & ":H" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    Range("C" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count + 1).Formula = "=COUNT(D" & wsTarget.Range(Marker).Row + OrigGapRow & ":D" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count & ")"
    Range("D" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count + 1).Formula = "=SUM(D" & wsTarget.Range(Marker).Row + OrigGapRow & ":D" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count & ")/60"
    Range("F" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count + 1).Formula = "=AVERAGE(F" & wsTarget.Range(Marker).Row + OrigGapRow & ":F" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count & ")"
    Range("G" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count + 1).Formula = "=ROUND(SUM(G" & wsTarget.Range(Marker).Row + OrigGapRow & ":G" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count & "),2)"
    Range("H" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count + 1).Formula = "=ROUND(SUM(H" & wsTarget.Range(Marker).Row + OrigGapRow & ":H" & wsTarget.Range(Marker).Row + GapRow + Rng.Cells.Count & "),2)"
End If
Sheets("Mapping_DB").Activate
End Sub
Sub SetupMasters()
Dim i As Long
Dim cell As Range
Dim timestartm As String
timestartm = Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Mapping_DB").Range("Sheet_Names").Clear
For i = 2 To Application.Sheets.Count
    Sheets("Mapping_DB").Range("D" & i) = Application.Sheets(i).Name
Next
ActiveWorkbook.Names("Sheet_Names").RefersTo = Sheets("Mapping_DB").Range("D2:D" & LastRow(Sheets("Mapping_DB"), "D"))
With Sheets("Mapping_DB")
    .Range("A2:B" & .UsedRange.Rows.Count).Clear
    Sheets("IN").Range("I2:I" & LastRow(Sheets("IN"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("OUT").Range("I2:I" & LastRow(Sheets("OUT"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("FAX").Range("I2:I" & LastRow(Sheets("FAX"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("Int").Range("I2:I" & LastRow(Sheets("Int"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    Sheets("Toll").Range("I2:I" & LastRow(Sheets("Toll"))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Mapping_DB").Range("A" & LastRow(Sheets("Mapping_DB"), "A") + 1), Unique:=True
    .Range("A1:A" & LastRow(Sheets("Mapping_DB"), "A")).RemoveDuplicates Columns:=1, Header:=xlYes
    For Each cell In .Range("A2:A" & LastRow(Sheets("Mapping_DB"), "A"))
        cell.Offset(0, 1).Validation.Delete
        cell.Offset(0, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Sheet_Names"
        cell.Offset(0, 1).Formula = "=iferror(vlookup(" & cell.Address & ",F:G,2,0),0)"
    Next cell
End With
Application.ScreenUpdating = True
MsgBox "Done, started at " & timestartm & vbCrLf & "Completed at " & Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
End Sub
Function LastRow(ws As Worksheet, Optional ColName As String) As Long
If ColName = "" Then
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
Else
LastRow = ws.Range("" & ColName & Rows.Count).End(xlUp).Row
End If
End Function
Function WorksheetExists(ByVal WorksheetName As String) As Boolean
Dim Sht As Worksheet
    For Each Sht In ThisWorkbook.Worksheets
        If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
            WorksheetExists = True
            Exit Function
        End If
    Next Sht
WorksheetExists = False
End Function

Private Sub InvoicePdf(ws As Worksheet, CoName As String, SerPeriod As String)
Dim tempstring As String
If Right(ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value, 1) = "\" Then
    tempstring = ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value & CoName & "-" & Replace(SerPeriod, "/", "-") & ".PDF"
Else
    tempstring = ThisWorkbook.Sheets("Mapping_DB").Range("fname").Value & "\" & CoName & "-" & Replace(SerPeriod, "/", "-") & ".PDF"
End If
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempstring, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ws.PrintOut From:=1, To:=1, Copies:=1, Preview:=False
End Sub
Sub PrintAllSheets()
Dim mySht As Worksheet
Dim timestartp As String
timestartp = Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
For Each mySht In ThisWorkbook.Worksheets
    With mySht
        If IsError(Application.Match(.Name, Sheets("Mapping_DB").Range("ExclTabs").Value, 0)) Then
            Call InvoicePdf(mySht, mySht.Range("B5").Value, mySht.Range("D2").Value)
        End If
    End With
Next mySht
MsgBox "Done, started at " & timestartp & vbCrLf & "Completed at " & Application.WorksheetFunction.Text(Now(), "hh:mm:ss")
End Sub

 

[Alex Blakenburg]

The most likely is that the full filename you are using does not exist.
What line is highlighted when you hit debug on that error dialogue box ?

Do you know how to use the immediate window ?

Try adding this

Debug.Print tempstring

Before this:

ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempstring, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

If you don't see the Immediate box hit Ctrl+G in the VBA editor
The last thing that prints to the immediate box should be the filename that failed.

 

[spongebob]

I will try this and report back, but it is not reading any file. The Worksheet that is open and being run from generates a PDF file for each tab in the worksheet that is not in the "deny or don't print list".

 

[spongebob]

The most likely is that the full filename you are using does not exist.
What line is highlighted when you hit debug on that error dialogue box ?

Do you know how to use the immediate window ?

Try adding this

Debug.Print tempstring

Before this:

ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempstring, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

If you don't see the Immediate box hit Ctrl+G in the VBA editor
The last thing that prints to the immediate box should be the filename that failed.

OK, the bad part is nothing additional was reported back.
The pop up box is the same with no additional data and if I click debug I get the attached image.
I can't seem to make it happen in any specific order, or on a specific tab.

[update]
If I go into immediate and click ?tempstring, I get a file name its trying to build which it never did.
I will try to see if there is something about that tab.

 

[Alex Blakenburg]

It is unlikely to be the Tab unless you have something in the Tab name that is not valid as a filename which seems unlikely.
You are getting the path name from a cell. It is more likely thatthe path name is invalid or when you string it together with the file name it is producing an invalid name.

 

[spongebob]

The file names are made up from a value in another tab, and is company names, and it has always worked correctly, nothing new on company names. ( 1 tab per company about 40 tabs ).
Then the file name is pulled from the location of the spreadsheet itself, and it does save a bunch, so there is no security type of issue either.
Just can't nail the issue.