0

I built a macro in Outlook that refers to the Word object library.

The macro is very large and consists of several subs and functions. The end goal of this macro is to convert the selected Outlook mailitem into a PDF via (via Word) and combine it with all PDF attachments.

I keep getting a runtime error 462 "the remote server machine does not exist or is unavailable."

I have narrowed down the line where this error is occurring. Code as follows:

    wdApp.Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(1.5), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces

As you can see, I am creating a qualified reference to the Word Application ("wdApp.Selection..."), but I suspect that somehow, I need to qualify the enumerators as well. How would I do this? Or if I am mistaken and the issue is with another part of the code, please let me know.

Here is the rest of my code (it is very lengthy).

Option Explicit
Sub wordToPDF()

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ANOTHER NOTE: you MUST disable sandbox protections in Adobe Acrobat or this
' macro will not work. You must uncheck "Enable Protected Mode at startup"
' within the "Sandbox Protections" section in the Adobe enhanced secutiy pref-
' erences.
' https://www.adobe.com/devnet-docs/acrobatetk/tools/AppSec/sandboxprotections.html#:~:text=Go%20to%20Edit%20%3E%20Preferences%20%3E%20Security,the%20feature%20controls%20as%20needed.
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

' Site below explains how to run Outlook VBA from Excel (applies here)
' https://hackernoon.com/how-to-create-word-documents-within-excel-vba-d13333jl

' Site below explains how to control multiple Office apps from one macro
' https://learn.microsoft.com/en-us/office/vba/excel/concepts/working-with- _
    other -applications / controlling - one - microsoft - office - Application - From - another

On Error GoTo errHandler1
    
    ' Set "True" if you want to run macro in debug mode
    Dim boolDebug As Boolean: boolDebug = False
    
    If boolDebug Then
        Debug.Print "#######################################################" & _
            vbCrLf & "BEGINNING MACRO" & _
            "#######################################################"
    End If
            
'================================================================================
' Initialize variables
'================================================================================
    ' Declare OUTLOOK objects
    Dim olSel As Outlook.Selection, olMI As Outlook.MailItem, _
        olAtt As Outlook.Attachment, olAtts As Outlook.Attachments

    ' Declare WORD objects
    Dim wdApp As Word.Application
    Dim wdDocs As Word.Documents
    Dim wdAllDocs As Word.Documents
    Dim wdDoc As Word.Document
    Dim wdItDoc As Word.Document
    Dim rgSel As Variant

    ' Declare other objects/variabels
    Dim myDate As String, olTempFolder As String, myPrinter As String, sUser As String, _
        sFrom As String, sTo As String, sCC As String, sBCC As String, _
        sSubj As String, dirExists As String, dirAttr As String, tempPath As String, _
        myDialogueTitle As String, sFileNamePDF As String, attFullPath As String, _
        sSenderEmail As String, arrHeader(1, 6) As String, sDay As String, sMonth As String, _
        sFinalPDF As String, sPdfRoot As String
    Dim dtSent As Date
    Dim Shex As Object
    Dim i As Integer
    Dim vItem As Variant
    
    ' Set Outlook objects
    Set olMI = GetCurrentItem ' Custom function
    
    ' Make day variable 2 characters in length
    If Len(Day(Now)) < 2 Then
        sDay = "0" & Day(Now)
    Else
        sDay = Day(Now)
    End If
    
    ' Make month variable 2 characters in length
    If Len(Month(Now)) < 2 Then
        sMonth = "0" & Month(Now)
    Else
        sMonth = Month(Now)
    End If
    
    ' Initialize date variable
    myDate = Year(Now) & sMonth & sDay & Hour(Now) & Minute(Now) & _
        Second(Now)
        
    ' Assign PDF printer to variable
    myPrinter = "Adobe PDF"
    
    ' Assign the window title of the save as pdf dialogue
    myDialogueTitle = "Save PDF File As"

'================================================================================
' Create email download path
'================================================================================
    ' Get the local temp folder path
    tempPath = ""
    tempPath = VBA.Environ("temp")
    
    ' Add Outlook Attachments subfolder to temp path
    olTempFolder = tempPath & "\Outlook Attachments"
    Debug.Print olTempFolder ' Print the folder path to immediate window
    
    ' If the path exists, check to make sure path is a directory, else create
    dirExists = Dir(olTempFolder, vbDirectory)
    If dirExists <> "" Then
        dirAttr = GetAttr(olTempFolder)
        
        ' Check if path is directory (attribute "16")
        If dirAttr <> 16 Then
            MsgBox "There is an error with the specified path. Check code " & _
                "try again."
            Exit Sub
        End If
        
    Else
    ' If folder does not exist, create
        MkDir (olTempFolder)
        
    End If
    
'================================================================================
' Delete items older than 14 days
'================================================================================
    Dim dNow, dLimit, dCreated As Date
    Dim fso, fsoF, oSubFolder, oFile As Object
    Dim sDebugFPath As String
    
    ' Assign current time and two weeks ago time
    dNow = Now()
    dLimit = DateAdd("d", -7, dNow)
    
    ' Get the outlook folder where items are being saved
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoF = fso.GetFolder(olTempFolder)
    
    ' Check each subfolder in temp outlook folder and delete if too old
    For Each oSubFolder In fsoF.SubFolders
        ' Get date created of iteration subfolder
        dCreated = oSubFolder.DateCreated
        ' If subfolder exceeds the file age limit, delete
        If dCreated < dLimit Then
            sDebugFPath = oSubFolder
            Debug.Print oSubFolder
            oSubFolder.Delete (True)
            Debug.Print "Deleted the following folder: " & sDebugFPath
        End If
    Next

    ' Delete any non-folder files in the temporary outlook folder
    For Each oFile In fsoF.Files
        fso.deletefile oFile
    Next
    
    Set fso = Nothing
    Set fsoF = Nothing
    
'================================================================================
' Create unique folder for this run
'================================================================================
    olTempFolder = olTempFolder & "\emailToPDF-" & myDate
    MkDir (olTempFolder)
    
    'Set filename.pdf
    sFileNamePDF = olTempFolder & "\!EmailMessage.pdf" '<-"!" for sorting

'================================================================================
' Save attachments from selected email
'================================================================================
    For Each olAtt In olMI.Attachments
        If Not isEmbedded(olAtt) Then
            attFullPath = olTempFolder & "\" & olAtt.DisplayName
            olAtt.SaveAsFile (attFullPath)
        End If
    Next
    
'================================================================================
' Initialize header variables
'================================================================================
    ' Get active user
    Dim myNamespace As Outlook.NameSpace
    Set myNamespace = Application.GetNamespace("MAPI")
    sUser = myNamespace.CurrentUser
    
    ' Get sender email
    sSenderEmail = getEmail(olMI)
    
    ' Assign header variables to array
    arrHeader(0, 0) = "From:"
    arrHeader(1, 0) = olMI.SenderName & " <" & sSenderEmail & ">"    ' From
    arrHeader(0, 1) = "Sent:"
    arrHeader(1, 1) = olMI.ReceivedTime   ' Rec'd Date/Time
    arrHeader(0, 2) = "To:"
    arrHeader(1, 2) = olMI.To   ' To
    arrHeader(0, 3) = "Cc:"
    arrHeader(1, 3) = olMI.CC   ' CC
    arrHeader(0, 4) = "Bcc:"
    arrHeader(1, 4) = olMI.BCC   ' BCC
    arrHeader(0, 5) = "Subject:"
    arrHeader(1, 5) = olMI.Subject   ' Subject
    arrHeader(0, 6) = "Attachments:"
    i = 0
    For Each olAtt In olMI.Attachments  ' Create string list of attachments
       
        ' If attachment is not embedded, add it to attachment string variable
        If Not isEmbedded(olAtt) Then
            ' Add semicolon before any non-embedded attachments after the first
            If i > 0 Then
                arrHeader(1, 6) = arrHeader(1, 6) & "; "
            End If
            ' Build attachment string within the header variable array
            arrHeader(1, 6) = arrHeader(1, 6) & olAtt
            i = i + 1
        End If
    Next
    i = 0
    
    If boolDebug Then
        For Each vItem In arrHeader
            Debug.Print vItem
        Next
    End If

'================================================================================
' Create word object and insert header
'================================================================================
    ' Set Word objects
    'Set wdApp = GetObject(, "Word.Application")
    Set wdApp = New Word.Application
    
    

    wdApp.Documents.Add
    wdApp.ActiveDocument.ActiveWindow.Visible = False

    ' Type the Username
    wdApp.Selection.Font.Bold = wdToggle
    wdApp.Selection.Font.Size = 13
    wdApp.Selection.TypeText Text:=sUser
    wdApp.Selection.Font.Size = 11
    wdApp.Selection.Font.Bold = wdToggle
    
    wdApp.Selection.TypeParagraph
    
    wdApp.Selection.MoveLeft unit:=wdCharacter, Count:=1
    
    ' Assign the selection to Range object
    Set rgSel = wdApp.Selection.Range

    ' Insert the border beneath username
'    on Error GoTo appError
'        rgSel.Borders(wdBorderBottom).LineStyle = Options.DefaultBorderLineStyle
'        rgSel.Borders(wdBorderBottom).LineWidth = wdLineWidth300pt
'        rgSel.Borders(wdBorderBottom).Color = Options.DefaultBorderColor
'        GoTo borderComplete
'    ' Try with wdApp.Selection
'appError:

        wdApp.Selection.Borders(wdBorderBottom).LineStyle = wdApp.Options.DefaultBorderLineStyle
        wdApp.Selection.Borders(wdBorderBottom).LineWidth = wdLineWidth300pt
        wdApp.Selection.Borders(wdBorderBottom).Color = wdApp.Options.DefaultBorderColor
'    On Error GoTo 0

'borderComplete:
'
'On Error GoTo errHandler1
'
''    Err.Raise 1000
'
    ' Move down and add paragraph
    wdApp.Selection.MoveDown unit:=wdLine, Count:=1
    wdApp.Selection.TypeParagraph

    ' ========================================
    ' Loop through array, adding elements if they exist
    ' ========================================
    i = 0
    For i = 0 To 6 '<==== probably need to find a way to make dynamic
        If arrHeader(1, i) <> "" Then
            wdApp.Selection.Font.Bold = wdToggle
            wdApp.Selection.TypeText Text:=arrHeader(0, i)
            wdApp.Selection.Font.Bold = wdToggle
            wdApp.Selection.TypeText Text:=vbTab & arrHeader(1, i)
            wdApp.Selection.TypeParagraph
        End If
    Next

    For i = 1 To 3
        wdApp.Selection.TypeParagraph
    Next

    ' Format the header
    wdApp.Selection.WholeStory
    MsgBox True
    
    wdApp.Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(1.5), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
    
    MsgBox True
    
    wdApp.Selection.ParagraphFormat.LineSpacing = LinesToPoints(100)
    ' Format the .ParagraphFormat
    wdApp.Selection.ParagraphFormat.LeftIndent = InchesToPoints(1.5)
    wdApp.Selection.ParagraphFormat.RightIndent = InchesToPoints(0)
    wdApp.Selection.ParagraphFormat.SpaceBefore = 0
    wdApp.Selection.ParagraphFormat.SpaceBeforeAuto = False
    wdApp.Selection.ParagraphFormat.SpaceAfter = 0
    wdApp.Selection.ParagraphFormat.SpaceAfterAuto = False
    wdApp.Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
    wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    wdApp.Selection.ParagraphFormat.WidowControl = True
    wdApp.Selection.ParagraphFormat.KeepWithNext = False
    wdApp.Selection.ParagraphFormat.KeepTogether = False
    wdApp.Selection.ParagraphFormat.PageBreakBefore = False
    wdApp.Selection.ParagraphFormat.NoLineNumber = False
    wdApp.Selection.ParagraphFormat.Hyphenation = True
    wdApp.Selection.ParagraphFormat.FirstLineIndent = InchesToPoints(-1.5)
    wdApp.Selection.ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText
    wdApp.Selection.ParagraphFormat.CharacterUnitLeftIndent = 0
    wdApp.Selection.ParagraphFormat.CharacterUnitRightIndent = 0
    wdApp.Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 0
    wdApp.Selection.ParagraphFormat.LineUnitBefore = 0
    wdApp.Selection.ParagraphFormat.LineUnitAfter = 0
    wdApp.Selection.ParagraphFormat.MirrorIndents = False
    wdApp.Selection.ParagraphFormat.TextboxTightWrap = wdTightNone
    wdApp.Selection.ParagraphFormat.CollapsedByDefault = False
    
    ' Format the .PageSetup
    wdApp.Selection.PageSetup.LineNumbering.Active = False
    wdApp.Selection.PageSetup.Orientation = wdOrientPortrait
    wdApp.Selection.PageSetup.TopMargin = InchesToPoints(0.5)
    wdApp.Selection.PageSetup.BottomMargin = InchesToPoints(0.5)
    wdApp.Selection.PageSetup.LeftMargin = InchesToPoints(0.5)
    wdApp.Selection.PageSetup.RightMargin = InchesToPoints(0.5)
    wdApp.Selection.PageSetup.Gutter = InchesToPoints(0)
    wdApp.Selection.PageSetup.HeaderDistance = InchesToPoints(0.5)
    wdApp.Selection.PageSetup.FooterDistance = InchesToPoints(0.5)
    wdApp.Selection.PageSetup.PageWidth = InchesToPoints(8.5)
    wdApp.Selection.PageSetup.PageHeight = InchesToPoints(11)
    wdApp.Selection.PageSetup.FirstPageTray = wdPrinterDefaultBin
    wdApp.Selection.PageSetup.OtherPagesTray = wdPrinterDefaultBin
    wdApp.Selection.PageSetup.SectionStart = wdSectionNewPage
    wdApp.Selection.PageSetup.OddAndEvenPagesHeaderFooter = False
    wdApp.Selection.PageSetup.DifferentFirstPageHeaderFooter = False
    wdApp.Selection.PageSetup.VerticalAlignment = wdAlignVerticalTop
    wdApp.Selection.PageSetup.SuppressEndnotes = False
    wdApp.Selection.PageSetup.MirrorMargins = False
    wdApp.Selection.PageSetup.TwoPagesOnOne = False
    wdApp.Selection.PageSetup.BookFoldPrinting = False
    wdApp.Selection.PageSetup.BookFoldRevPrinting = False
    wdApp.Selection.PageSetup.BookFoldPrintingSheets = 1
    wdApp.Selection.PageSetup.GutterPos = wdGutterPosLeft
    
    ' Copy formatted email body of text
    Dim wdItemWordEditor As Object
    Set wdItemWordEditor = olMI.GetInspector.WordEditor
    wdItemWordEditor.Range.Copy
    
    ' Paste email body into word doc after header
    wdApp.Selection.MoveStart unit:=wdCharacter, Count:=1000000
    wdApp.Selection.Paste
    
    ' Re-select the whole word doc
    wdApp.ActiveDocument.Select
    
    ' Remove paragraph spacing
    wdApp.Selection.ParagraphFormat.SpaceBefore = 0
    wdApp.Selection.ParagraphFormat.SpaceBeforeAuto = False
    wdApp.Selection.ParagraphFormat.SpaceAfter = 0
    wdApp.Selection.ParagraphFormat.SpaceAfterAuto = False
    wdApp.Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle

'================================================================================
' Print/save email as PDF
'================================================================================
    ' Print doc to PDF
    wdApp.ActiveDocument.SaveAs2 FileName:=sFileNamePDF, FileFormat:=wdFormatPDF

    ' Close doc and close word
    wdApp.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    
    wdApp.Quit savechanges:=wdDoNotSaveChanges
    
    Set wdApp = Nothing

'================================================================================
' Print/save email as PDF
'================================================================================
    sPdfRoot = olTempFolder
    
    ' Run custom function to merge PDFs and return the final PDF path
    sFinalPDF = mergePDF(sPdfRoot)
    
'================================================================================
' Open the newly created PDF
'================================================================================
    ' Create shell object
    Set Shex = CreateObject("Shell.Application")
    
    ' Redundancy IF statement. If function successful, use that path. Otherwise _
        use the default path in main sub.
    If Not sFinalPDF = "" Then
        Shex.Open (sFinalPDF)
    Else
        Shex.Open (sFileNamePDF)
        ' This route is less reliable because the merge PDF function selects _
            only one of the PDFs in the temp folder as the primary. After _
            merge, it deletes the rest of the PDFs in the folder. If it _
            selected a primary file other than the sFileNamePDF path, then _
            this route will not open the file in Adobe because sFileName PDF _
            will not exist.
    End If
    
Exit Sub

'================================================================================
' Error handling
'================================================================================
' General error handling statement
errHandler1:
    MsgBox "There was an unexpected error with the macro." & vbCrLf & _
        "Error Number: " & Err.Number & vbCrLf & _
        "Error Message: " & Err.Description

End Sub
Private Function isEmbedded(Att As Outlook.Attachment) As Boolean
' This function determines whether the passed mailitem.attachment is embedded
' https://stackoverflow.com/questions/59075501/ _
    find-out-if-an-attachment-is-embedded-or-attached
  
  Dim PropAccessor As Outlook.PropertyAccessor
    
  On Error GoTo outlook_att_IsEmbedded_error
    
  isEmbedded = False
    
  Set PropAccessor = Att.PropertyAccessor
        
  If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E") <> "" Or _
     PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3713001E") <> "" Then
           
    If PropAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x37140003") = 4 Then
       isEmbedded = True
    End If
  End If

outlook_att_IsEmbedded_exit:
  Set PropAccessor = Nothing

  Exit Function

outlook_att_IsEmbedded_error:
  isEmbedded = False
  Resume outlook_att_IsEmbedded_exit
                
End Function
Private Function GetCurrentItem() As Object
' Purpose: this function returns the active MailItem, whether from the Explorer or Inspector.

'================================================================================
' Initialize variables
'================================================================================
    Dim olApp As Outlook.Application
    Dim sMailTest As String
    
    Set olApp = Application
    
'================================================================================
' Initialize variables
'================================================================================
    On Error Resume Next
    
    ' Determine whether active item is Explorer or Inspector object
    Select Case TypeName(olApp.ActiveWindow)
        ' If explorer item selected, return explorer MailItem
        Case "Explorer"
            sMailTest = TypeName(olApp.ActiveExplorer.Selection.Item(1))
            If Not sMailTest = "MailItem" Then
                MsgBox "The selected item is not an Email. Please select another item."
                End
            End If
            Set GetCurrentItem = olApp.ActiveExplorer.Selection.Item(1)
        ' If inspector item selected, return inspector MailItem
        Case "Inspector"
            sMailTest = TypeName(olApp.ActiveInspector.CurrentItem)
            If Not sMailTest = "MailItem" Then
                MsgBox "The selected item is not an Email. Please select another item."
                End
            End If
            Set GetCurrentItem = olApp.ActiveInspector.CurrentItem
    End Select
       
    Set olApp = Nothing
End Function
Private Function getEmail(mail As Outlook.MailItem) As String
' Purpose: Return the readable email address of an Outlook user

' Modified version of the following solution: _
    https://stackoverflow.com/a/26171979/17312223

'================================================================================
' Declare variables
'================================================================================
    Dim PR_SMTP_ADDRESS As String
    
'================================================================================
' If mail item not selected, exit function
'================================================================================
    If mail Is Nothing Then
        getEmail = vbNullString
        Exit Function
    End If

'================================================================================
' Retrieve sender email from mail item
'================================================================================
    If mail.SenderEmailType = "EX" Then
        Dim sender As Outlook.AddressEntry
        Set sender = mail.sender
        If Not sender Is Nothing Then
            'Now we have an AddressEntry representing the Sender
            If sender.AddressEntryUserType = Outlook.OlAddressEntryUserType. _
                olExchangeUserAddressEntry Or sender.AddressEntryUserType = _
                Outlook.OlAddressEntryUserType.olExchangeRemoteUserAddressEntry Then
                'Use the ExchangeUser object PrimarySMTPAddress
                Dim exchUser As Outlook.ExchangeUser
                Set exchUser = sender.GetExchangeUser()
                If Not exchUser Is Nothing Then
                     getEmail = exchUser.PrimarySmtpAddress
                Else
                    getEmail = vbNullString
                End If
            Else
                 getEmail = sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
            End If
        Else
            getEmail = vbNullString
        End If
    Else
        getEmail = mail.SenderEmailAddress
    End If
End Function
Private Function mergePDF(sPdfRoot As String)
' Purpose: to merge multiple PDFs together into one.

' Macro influenced by the following solution: _
    https://stackoverflow.com/a/51690835/17312223
' If having issues with saving the merged pdf, see the following URL: _
    https://stackoverflow.com/questions/71580519/pddoc-save-adobe-acrobat-method-not-working-in-excel-vba

On Error GoTo errHandler1
' ================================================================================
' Declare variables / create objects
' ================================================================================
    Dim app As Object
    Dim sFile As String
    Dim iFwd As Integer
    Dim iBwd As Integer
    Dim iLArr As Integer
    Dim i As Integer
    Dim arrayFilePaths() As Variant
    ReDim arrayFilePaths(0) ' Enable LBound and UBound calling
    Dim primaryDoc As Object
    Dim OK As Variant
    Dim arrayIndex As Integer
    Dim numPages As Integer
    Dim numberOfPagesToInsert As Integer
    Dim sourceDoc As Object
    Dim PDSaveFull As Variant
    
    ' Create Adobe app object
    'Set app = CreateObject("Acroexch.app")
    
    ' Create Adobe PDF object
    Set primaryDoc = CreateObject("AcroExch.PDDoc")
    
' ================================================================================
' Initialize variables
' ================================================================================
    ' Assign position of ending slash to variable
    iFwd = InStrRev(sPdfRoot, "/") ' Forward slash
    iBwd = InStrRev(sPdfRoot, "\") ' Backward slash
    
    ' Check for ending slash existence
    If Not iFwd > 0 Or Not iBwd > 0 Then
        ' If no ending slash, add
        sPdfRoot = sPdfRoot & "\"
    End If
    
' ================================================================================
' Loop through root, assigning PDF files to array
' ================================================================================
    ' Assign directory and wildcard to search for within
    sFile = Dir(sPdfRoot & "*.pdf*")
    
    ' Get lowest boundary of array dimension
    iLArr = LBound(arrayFilePaths)
    
    ' Assign lower array boundary to beginning iteration counter
    i = iLArr
    
    ' Loop through the entire array
    Do While sFile <> ""
        ' Add additional space to array variable
        ReDim Preserve arrayFilePaths(iLArr To i)
        ' Assign the iteration file to the new array space
        arrayFilePaths(i) = sPdfRoot & sFile
        ' Iterate counter by 1
        i = i + 1
        ' Iterate to next file in directory
        sFile = Dir()
    Loop
    i = 0
    
    ' Set the primary PDF document
    OK = primaryDoc.Open(arrayFilePaths(0))
    Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
    
    ' Return the path of primary document
    mergePDF = arrayFilePaths(0)

' ================================================================================
' Loop through non-primary PDFs
' ================================================================================
    For arrayIndex = 1 To UBound(arrayFilePaths)
        ' Get number of pages of primary PDF _
            (minus one bc "insertPages" index starts at 0)
        numPages = primaryDoc.GetNumPages() - 1
        
            'Debug.Print "Number of pages in primary doc = " & numPages
        ' Set iteration PDF to be merged into primary
        Set sourceDoc = CreateObject("AcroExch.PDDoc")
        
        ' Open iteration PDF
        OK = sourceDoc.Open(arrayFilePaths(arrayIndex))
            'Debug.Print "source doc = " & arrayFilePaths(arrayIndex)
        ' Get number of pages of iteration PDF
        Debug.Print "SOURCE DOC OPENED & PDDOC SET: " & OK
        
        numberOfPagesToInsert = sourceDoc.GetNumPages
        
            'Debug.Print "# Pages to insert = " & numberOfPagesToInsert
        ' Insert iteration PDF into primary document
        OK = primaryDoc.InsertPages _
            (numPages, sourceDoc, 0, numberOfPagesToInsert, False)
            Debug.Print _
                "============================================" & vbCrLf & _
                "# total pages: " & numPages + 1 & vbCrLf & _
                "source doc name: " & sourceDoc.GetFileName() & vbCrLf & _
                "# pages to insert: " & numberOfPagesToInsert
        Debug.Print "PAGES INSERTED SUCCESSFULLY: " & OK
        
        ' Save primary PDF that now contains iteration PDF
        OK = primaryDoc.Save(PDSaveFull, mergePDF) 'arrayFilePaths(0)
        Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
        
        ' Close the iteration document
        OK = sourceDoc.Close
        
        ' Delete the iteration document (since it is merged into primary)
        Kill (arrayFilePaths(arrayIndex))
        
        ' Clear iteration object
        Set sourceDoc = Nothing
        
    Next arrayIndex
    
    
    
' ================================================================================
' Clear objects/variables
' ================================================================================
    Set primaryDoc = Nothing
    'app.Exit
    'Set app = Nothing

' ================================================================================
' Error handling
' ================================================================================
Exit Function
errHandler1:
    Debug.Print "###########################################################" & _
        vbCrLf & "There was an error within the PDF portion of the macro." _
        & vbCrLf & "Error #: " & Err.Number & "Error Msg: " & Err.Description & _
        vbCrLf & "###########################################################"

' ================================================================================
' End sub
' ================================================================================
End Function


Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
  • 1
    Have you seen [this](https://stackoverflow.com/questions/26030584/error-462-the-remote-server-machine-does-not-exist-when-working-with-word-via-e) related post? I would try to replace `InchesToPoints()`. – Axel Kemper Sep 16 '22 at 21:56
  • 1
    `InchesToPoints` is a Word function so it needs to be qualified as `wdApp.InchesToPoints` – Timothy Rylatt Sep 17 '22 at 07:28
  • 1
    `1 inch = 72 points` should be easy to compute. I would avoid the hassle to involve an application object. – Axel Kemper Sep 17 '22 at 10:19
  • This fixed my issue. I have numerous instances of InchesToPoints in my code as well as LinesToPoints. Once I addressed each of these, my code ran without issue. – Logan Price Sep 17 '22 at 11:05

0 Answers0