The issue remains basically that I pointed out, but as you have posted the code, I have modified it so that it does work (provided you download the code from the link and put it in a separate module in your project).


Option Explicit

Sub PDF_Save_and_Email_FINAL()

'Use the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to start Outlook or you are likely to find that your messages simply disappear
'Code modified to call that function
'Graham Mayor - https://www.gmayor.com - Last updated - 15 May 2020

Dim OlApp As Object
Dim OutlookMail As Object, olInsp As Object
Dim wdDoc As Document
Dim oRng As Range
Dim StrFolder As String, DocName As String, PDFFile As String
Dim MainDoc As Document
Dim i As Long, j As Long
Dim EmailTo As String, EmailSubject As String, PDFUpload As String
Dim ReplyToTeachers As String, strSalutation As String
Const StrNoChr As String = """*./\:?|"

    Set MainDoc = ActiveDocument
    MainDoc.Save

    Application.ScreenUpdating = False

    With MainDoc
        StrFolder = .Path & "\"
        DocName = InputBox("DocumentName")
        EmailSubject = DocName

        With .MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True

            'start outlook before the loop
            Set OlApp = OutlookApp()

            On Error Resume Next

            For i = 1 To .DataSource.RecordCount
                With .DataSource
                    .FirstRecord = i
                    .LastRecord = i
                    .ActiveRecord = i
                    If Trim(.DataFields("LastName")) = "" Then Exit For
                    'below line '

                    'set the variable values from the data BEFORE creating the messages

                    PDFFile = .DataFields("FirstName") & " " & .DataFields("LastName") & " - " & DocName
                    EmailTo = .DataFields("StudentNumber")
                    ReplyToTeachers = .DataFields("Teacher")
                    strSalutation = .DataFields("FirstName")

                    MainDoc.MailMerge.Execute Pause:=False
                    If Err.Number = 5631 Then
                        Err.Clear
                        GoTo NextRecord
                    End If
                    For j = 1 To Len(StrNoChr)
                        PDFFile = Replace(PDFFile, Mid(StrNoChr, j, 1), "_")
                    Next j
                    PDFFile = Trim(PDFFile)
                    With ActiveDocument
                        'Add the name to the footer
                        '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
                        '.SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
                        ' and/or:
                        .SaveAs FileName:=StrFolder & PDFFile & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                        .Close SaveChanges:=False
                        PDFUpload = StrFolder & PDFFile & ".pdf"
                    End With


                    'Create a new mail message

                    Set OutlookMail = OlApp.CreateItem(0)

                    'Display email and specify To, Subject, etc
                    With OutlookMail
                        .BodyFormat = 2
                        .Display
                        .To = EmailTo
                        .Subject = EmailSubject
                        .Attachments.Add PDFUpload
                        .ReplyRecipients.Add ReplyToTeachers
                        Set olInsp = .GetInspector
                        Set wdDoc = olInsp.WordEditor
                        Set oRng = wdDoc.Range
                        oRng.Collapse 1
                        oRng.Text = "Hi " & strSalutation & vbCr & vbCr & _
                                    "Please find attached your document:- '" & PDFFile & ".pdf'"
                        'default signature for the sending account will be retained

                        .send
                    End With
                End With
NextRecord:
            Next i

        End With
    End With
    Application.ScreenUpdating = True
    Set OlApp = Nothing
    Set OutlookMail = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set MainDoc = Nothing
End Sub