Sub ExportPDF()
'UpdatebyExtendoffice20181120
    Dim I As Long
    Dim xDlg As FileDialog
    Dim xFolder As Variant
    Dim xStart As Integer, xEnd As Integer
    
    ActiveDocument.ComputeStatistics (wdStatisticPages)
    'MsgBox "Page count = " & ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    
    On Error GoTo lbl
    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If xDlg.Show <> -1 Then Exit Sub
    xFolder = xDlg.SelectedItems(1)
    xStart = CInt(InputBox("Start Page", "PDF Export"))
    xEnd = CInt(InputBox("End Page:", "PDF Export"))
    
    If ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) < xEnd Then
        MsgBox "End page is more than total pages."
        Exit Sub
    End If
    
    If xStart <= xEnd Then
        If Int((xEnd + 1 - xStart) / 2) <> (xEnd + 1 - xStart) / 2 Then
            MsgBox "Start and end pages does not include an even number of pages."
            Exit Sub
        End If
        For I = xStart To xEnd Step 2
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                xFolder & "\Page_" & I & "_and_" & I + 1 & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportFromTo, From:=I, To:=I + 1, Item:=wdExportDocumentContent, _
                IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
                wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=False, UseISO19005_1:=False
        Next
    End If
    Exit Sub
lbl:
    MsgBox "Enter right page number", vbInformation, "PDF Export"
End Sub