Hi friends,

In the following code I want to send emails to the selected records as per the requirement of the user. At present it’s sending emails to all the records in the database. There are about 5000 records in the database. To avoid duplicate sending mails I want to insert ‘Sent’ remark in the ‘REMARK’ field. If there is ‘Sent’ remark in ‘REMARK’ field then I want to skip that record while mailing. For this I want add input box to enter the number of first and last record. How to amend the code to achieve this target?

Option Explicit

Sub Email()
Dim wdApp As New Word.Application, wdDoc As Word.Document, i, x, y As Long, BlnEx As Boolean
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const strQry As String = "SELECT * FROM `Data$`"

Application.ScreenUpdating = False

With wdApp
  'Disable alerts to prevent an SQL prompt
  .DisplayAlerts = wdAlertsNone
  'Open the mailmerge main document
  Set wdDoc = .Documents.Open(ThisWorkbook.Path & "\INPUT\XYZ COMPANY.docx", _
    ConfirmConversions:=False, ReadOnly:=True, AddToRecentfiles:=False)
  With wdDoc
    With .MailMerge
'Define the mailmerge type
.MainDocumentType = wdEMail
'Define the output
.Destination = wdSendToEmail
.SuppressBlankLines = True
      'Connect to the data source
      .OpenDataSource Name:=strWorkbookName, ReadOnly:=True, _
        LinkToSource:=False, AddToRecentfiles:=False, _
        Format:=wdOpenFormatAuto, _
        Connection:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "User ID=Admin;Data Source=strWorkbookName;" & _
        "Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
        SQLStatement:=strQry, SubType:=wdMergeSubTypeAccess
For i = 1 To .DataSource.RecordCount
BlnEx = True
With .DataSource
'x = InputBox("What is the first record to merge?")
    'y = InputBox("What is the last record to merge?")
    'If x = 0 Or y = 0 Or y < x Then Exit Sub
    'If y > Range("A" & Rows.count).End(xlUp).Offset(0, 0).Value Then
'y = Range("A" & Rows.count).End(xlUp).Offset(0, 0).Value
    'End If
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
'If Trim(.DataFields("EMAIL")) = "-" Then Exit For
If Trim(.DataFields("EMAIL")) = "-" Then BlnEx = False
End With
.MailFormat = wdMailFormatHTML
.MailSubject = "Test Email"
.MailAddressFieldName = "EMAIL"
'.MailAsAttachment = True
If BlnEx = True Then .Execute Pause:=False
Next i
'Disconnect from the data source
      .MainDocumentType = wdNotAMergeDocument
    End With
    'Close the mailmerge main document
    .Close False
  End With
  'Exit Word
.Quit
'Restore the Word alerts
  .DisplayAlerts = wdAlertsAll
  End With
  
  Application.ScreenUpdating = True
  
Set wdDoc = Nothing: Set wdApp = Nothing
'MsgBox "Congratulation! The " & y - x + 1 & " emails are generated successfully!", 64
MsgBox "done", 64
End Sub
Any help will be highly appreciated.

Thanking you in anticipation.