' Declare Public variables so Userform can see them
Public pbApp As Object
Public FullPath As String
Public pbDoc As Object

Public Sub PublisherPrint()



' Saves the workbook, updates links in Publisher, saves as pdf, and (optionally) prints

' Late-Binding


Dim ReportDate As Range
Dim FileDate As String
Dim i As Integer
Dim PubChkCounter As Long

Dim shpShape As Object
Dim PgCnt As Object


Application.ScreenUpdating = False

On Error GoTo ErrHandler

' Save the workbook so Publisher can see current changes
Application.StatusBar = "Saving..."

ActiveWorkbook.Save


' Make sure Publisher is not running
' [Because Publisher has a single document interface, the Open method only works when you open a new instance of Publisher]

    ' Initialize counter for preventing infitite loops
    PubChkCounter = 0


setpoint:  ' setpoint for loop

    On Error Resume Next
    ' Check for open instance
    Set pbApp = GetObject(, "Publisher.Application")
        PubChkCounter = PubChkCounter + 1 ' Iterate counter

        If Err.Number = 0 Then ' Publisher is open
            If PubChkCounter < 6 Then ' Limits loop to 5 iterations
                    If MsgBox("Publisher is running; please close before proceeding." & vbCrLf & "(May have to force close from task manager.)", vbOKCancel, "Warning") = vbOK Then ' User clicked OK
                            GoTo setpoint
                        Else ' User pressed Cancel
                            MsgBox "Procedure cancelled. No export saved."
                            Exit Sub
                        End If
                Else ' Too many iterations
                    MsgBox "Procedure cancelled. No export saved." & vbCrLf & "Please close Publisher and try again."
                    Exit Sub
            End If
            Else ' Publisher is closed

       Set pbApp = CreateObject("Publisher.Application") ' Bind to a new instance of Microsoft Publisher
       End If


On Error GoTo ErrHandler


Application.StatusBar = _
            "Updating Publisher tables..."


' Open file
Set pbDoc = pbApp.Application.Open("X:\[Path]\[Filemame].pub")


pbApp.Open FileName:="X:\[Path]\[Filemame].pub"
   pbApp.ActiveWindow.Visible = False


' Update linked tables

' Insert pause to allow Publisher to open fully
  If iFirstTimeThrough <> "NO" Then Application.Wait (Now + TimeValue("0:00:02"))
    iFirstTimeThrough = "NO"

' Loop through all pages one at a time
   For Each PgCnt In pbApp.Application.ActiveDocument.Pages

          ' Loop through all shapes in each page
        For Each shpShape In PgCnt.Shapes
                If shpShape.Type = 10 Then
                   shpShape.LinkFormat.Update
                End If
        Next shpShape

    Next PgCnt

 ' Do the same for shapes in the Master Page, as it's a separate entity from ActiveDocument.Pages

    For Each shpShape In pbApp.Application.ActiveDocument.Pages(1).Master.Shapes
        If shpShape.Type = 10 Then
            shpShape.LinkFormat.Update
        End If
    Next shpShape

' Pause to allow tables to update
If iFirstTimeThrough <> "NOAGAIN" Then Application.Wait (Now + TimeValue("0:00:05"))
        iFirstTimeThrough = "NOAGAIN"

Application.StatusBar = _
            "Exporting pdf..."

' Save updated Publisher file
pbApp.ActiveDocument.Save

' Export as .pdf
    Const FileExtension As String = ".pdf"

    Dim FSO As Object
    Dim SupplierName As String
    Dim FolderPath As String
    Dim FileName As String

    Dim Version As Long


    Application.DisplayAlerts = False

    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' Set date variable based on named range from top of spreadsheet
    FileDate = Range("ReportDate")

    ' Set path and filename
    FilePath = "X:\[Path]\"
    FileName = "[Filename]_" & Format(FileDate, "MM.DD.YYYY")
    FullPath = FilePath & FileName & FileExtension

    ' Check if file already exists, append sequential numbers to filename if it does
    Do While FSO.fileexists(FullPath)
        Version = Version + 1
        FullPath = FilePath & FileName & " (" & Version & ")" & FileExtension
    Loop

    ' Save .pdf
    pbApp.ActiveDocument.ExportAsFixedFormat 2, FullPath

   Application.StatusBar = _
            "Printing & opening pdf..."

   ' Inform of succesful save, ask if user wants to display and/or print
      Set frmUserform = SavePrintDialogue

   With frmUserform
    .Label1.Caption = "Your file has been saved as " & FullPath & vbCrLf & vbCrLf & "Print a hardcopy?"


End With
frmUserform.Show


Application.DisplayAlerts = True


' Close and clear Publisher
pbApp.Quit
Set pbDoc = Nothing
Set pbApp = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True

Exit Sub

ErrHandler:
MsgBox "There seems to be an error" & vbCrLf & Err.Description

End Sub