How to add input box for require record to mail?

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.

We have had this discussion before (see: https://www.excelforum.com/word-form...e-request.html; and https://www.excelforum.com/excel-pro...tax-error.html) and the answer hasn't changed.

Hi Paul,

As per your suggestion I tried my level best to learn mail merge. I amended the code and now the mails are delivering as per input first and last number. I didn't understand the filter as you suggested in previous thread. Please do suggest me a code to skip those records which has dash sign in 'email' field and add a remark in 'remark' field after delivering the mail. Now I'm getting error if there is a dash sign in email column.

Please do suggest me an amendment positively in the present code because it's working fine. Only an amendment to skip record and add 'Sent' remark problem is to solve. I don't want to prolong the thread as previous to waste your time for the same problem again.

Option Explicit

Sub Email()
Dim wdApp As New Word.Application, wdDoc As Word.Document, 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
With .DataSource
BlnEx = True
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 = x
.LastRecord = y
.ActiveRecord = x
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
'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
End Sub

Thanking you,

I am still waiting to see some evidence that you've applied a mailmerge filter. Your strQry says otherwise... You might at least spend a few moments learning how to use mailmerge filters, apply the required filter to your mailmerge main document, then run the macro I gave you that will show how strQry needs to be modified.

Hi Paul,

Thank you for your kind efforts to make me learn mail merge filter.

Extremely sorry for not understanding apply mail merge filter. In ‘Mailing’ tab there is a option ‘Rule’ to filter the records. It’s my understanding. There is a option ‘skip it’ to exclude the records from mail merge but you said it’s not you mean. By using it I get the require output but I want to learn what is ‘apply mail merge filter’ a proper way from you. How to do it? I tried my level best to learn it but in vain. So how can I give you some evidence of ‘apply filter mail merge’? Please don’t mind. If I will learn it now then I hope that it will be my last post on this topic.

With ActiveDocument.MailMerge.Fields
.AddSkipIf Range:=Selection.Range, _
        MergeField:="EMAIL", Comparison:=wdMergeIfEqual, CompareTo:="-"
.AddSkipIf Range:=Selection.Range, _
        MergeField:="REMARK", Comparison:=wdMergeIfEqual, CompareTo:="Sent"
End with

Please guide me the proper way to ‘apply filter in mail merge’ positively.

Thanking you in anticipation.

I have already told you how to apply a filter. The code in your posts does not do that; it tries to add SKIPIF fields to the mailmerge main document instead. To apply a Filter, you do not use the 'Rules' button to add fields*; neither do you need the macro recorder; you use the 'Edit Recipient List' button and choose 'Filter' so you can apply the Filter. Once you've done that correctly, running the TestSQL macro I provided in https://www.excelforum.com/excel-pro...ml#post4540650, will show you what your strQry string should be.

* Of course, adding such fields to the mailmerge main document is another way of achieving the same result, but you would only do that once (manually - before saving the updated mailmerge main document); you certainly would use a macro to add it to the mailmerge main document every time you run the mailmerge.

Hi Paul,

Greetings from me!

Oops! What a silly mistake I was doing since last 2/3 month to apply filter. Now I understood what is ‘apply filter’ and got require output after running the mail merge from word. I tried to record it to put it in the mail merge macro from excel but failed; no recording. It’s very simple and easy to follow.

Please see the attached workbook and guide me how to put that code in macro strQry string to achieve the target automatically.

Sub TestSQL()
With ActiveDocument.MailMerge
  If .MainDocumentType <> wdNotAMergeDocument Then 
    MsgBox "Mail Merge Query String:" & vbCr & .DataSource.QueryString
  Else
    MsgBox "Not A Merge Document"
  End If
End With
End Sub

Thanking you,

The macro is a Word macro. You run it in Word against your mailmerge main document after you have correctly set the filter. You can test whether the filter is correct by running the mailmerge from your mailmerge main document (not from Excel) and checking the output. Once the output is correct, running the macro will tell you what your strQry string should be.

Hi Paul,

Thank you for your kind guidance. Now I’m getting correct output using filter. I have recorded the macro to get sql statement. I didn’t understand how to amend it in our code strQry string to make it automatic.

 Option Explicit

Sub Macro1()
'
' Macro1 Macro
'
'
    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "E:\MAIL MERGE\DATABASE.xlsm", ConfirmConversions:=False, ReadOnly:=False _
        , LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", WritePasswordDocument:="", WritePasswordTemplate:= _
        "", Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=E:\MAIL MERGE\DATABASE.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking Mode=0;Jet " _
        , SQLStatement:="SELECT * FROM `Data$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
End Sub

Thanking you,

I did not say to record a macro; I said to run the macro I gave you. Your recorded macro quite possibly broke the filtering that you had applied. Re-apply the filter, then run the macro I gave you.

Hi Paul,

Greetings from me!

As per your suggestion I ran the word macro you gave. It’s running fine using filter. The filtered output was correct as per requirement. You have used ‘Const StrNoChr As String = """*./\:?|"’ sql string to show what we don’t want in the sql statement. However, I didn’t understand how to amend the present email code qry statement. I don’t have any knowledge of it because I have not learned it before. By practice and a valuable guidance from you friends I learn a lot. I learned a mail merge filter function from you now and found very easy and useful. I will use it in future. Now we are very close to solve the problem. Therefore, I request you to suggest me the amendment to complete the macro positively. I have taken a lot of time to learn it and trouble you more. Do amend the code for this time; I will learn from it positively. I myself feeling very guilty to come on the forum for the same problem again and again.

I learn a lot from you regarding mail merge. I by heart appreciate you for the same.

Have a nice day.

Thanking you,

Originally Posted by mso3

I ran the word macro you gave. It’s running fine using filter. The filtered output was correct as per requirement. You have used ‘Const StrNoChr As String = """*./\:?|"’ sql string to show what we don’t want in the sql statement

That expression has nothing at all to do with the sql statement! It's sole purpose is to guard against the output documents having invalid filenames. The macro that code is for is a Word macro. If that's all you need, you don't need to modify anything once you've applied the filters.

Previously, however, you've said you wanted to run the mailmerge from Excel - which is what the code your first post in this thread is for - and for that you would need to modify the SQL statement which, in that code, is defined by:
Const strQry As String = "SELECT * FROM `Data$`"
and that's what the TestSQL is to help with.

You really do need to be clearer about your requirements and pay attention to the advice given. Most of the posts in the multiple threads you've started on this topic (contrary to the forums rules) have been due to you not doing either of those things.

Hi Paul,

Sorry for misunderstanding. I have posted my problem for the code below post1 as follows:

I want to send mails to the selected records on the following conditions:
If there is dash sign in email id then skip record
If there is ‘Send’ remark in column ‘REMARK’ then send mail
‘We have set filter for it
After sending mail add/change remark in column ‘REMARK’ ‘Send’ to ‘Sent’
Input box for entering the first and last record number
I want to run the macro from excel only.

These are my initial requirements in the first post. The macro below is run from excel and I want to run it from excel only not from word. Due to my misunderstanding I didn’t follow your instruction properly; language problem because English is not my main language. As per your guidance I learned the filter function which I found easy and useful. After that you asked me to amend the qry to get the require output from excel. Here, a problem that I didn’t understand your instruction properly. Since last 2/3 months I’m trying to achieve the require output but in vain. Today after learning the filter function we are about to very close of the final solution. I’m also feeling very sorry for troubling you for the same problem repeatedly. I’m extremely sorry for that.

I don’t have any computer/programming degree. I learn it by practice and the valuable guidance from the forum friends like you. I request you to amend the code below to run from excel for the last time. I assure you that I will learn from it and will not post any thread on the same topic on the forum again in future. Please apologize me and do the favor to solve my problem for ever regarding mail merge from excel.

Option Explicit

Sub Email()
Dim wdApp As New Word.Application, wdDoc As Word.Document, 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 mail merge 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
With .DataSource
BlnEx = True
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 the 'Y' is greater than last entry/record number then 'y' should be the last entry/record number
    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 = x
.LastRecord = y
.ActiveRecord = x
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
'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
End Sub

Once again sorry for trouble.

Thanking you in anticipation.

Originally Posted by mso3

I want to send mails to the selected records on the following conditions:
If there is dash sign in email id then skip record
If there is ‘Send’ remark in column ‘REMARK’ then send mail
‘We have set filter for it

So what is the QueryString after applying the filter????? I have given you a macro for retrieving that. You have quoted it. Yet you seem never to have used it!!!!

Originally Posted by mso3

After sending mail add/change remark in column ‘REMARK’ ‘Send’ to ‘Sent’

Which column in the workbook is that? And which column in the workbook contains the email ID?

Originally Posted by mso3

Input box for entering the first and last record number

It's not apparent to my why you need both the inputbox and the filter. The filter can be used to automatically exclude all 'Sent' records without the need for an input box. The inputbox would only be needed if there are records without 'Sent' that you still don't want to send to.

Originally Posted by mso3

I want to run the macro from excel only.

In that case, stop messing with Word-specific macros (e.g. post #9 ) or macros that aren't for sending emails (e.g. post #11) and follow the advice given.

Originally Posted by mso3

I don’t have any computer/programming degree.

Nor do I. All that I know about using MS Office, including programming, is self-taught - often drawing on the work of others who provided useful examples. Indeed, what I have posted in forums over the years has had nothing to do with the kind of work I did in my former employment and much of it has been learnt during my retirement while helping people like you solve their problems.

Hi Paul,

I have already posted my workbook containing word document, excel workbook post no. 7. Please see that again for me because the misunderstanding is still there for 'from excel and from word'. From excel I mean is; the letter is in word main document, the data is in excel workbook, the macro is in excel workbook and I want to run it from there as in the workbook attached post7.

The email is in column 'H' and remark is in column 'V' in excel workbook.

Due to misunderstanding we have confusion. Hope after seeing the attached workbook it will clear.

Ok, if the filter can do the job then no need of input box for first-last record require.

Please don't mind. I respect you and always appreciate you for your kind guidance to me and other friends on the forum.

Please do the necessary amendments in the code and send me the final code to avoid confusion and close this thread today positively.

thanking you in anticipation.

I will ask again:
1. What is the QueryString after applying the filter?
2. Since a properly-implemented filter will automatically skip records with 'Sent' in the 'Remark' column and '-' in the 'Email ID' column, why do you need the inputboxes as well?
Until you answer both questions, I'm not going to waste any more time on this.

Hi Paul,

Greetings from me!

Glad to inform you that I have successfully amended the qry and getting correct output as per requirement.

Now the remark and message count problem is to solve.
After sending mail change remark 'Send' to 'Sent' in column 'V'
At the end message how many mails sent.
Input box for if the user wants to mail/create letter for the particular record only for duplicate receipt.

Doubt: There are about 5000 records in the database. If we didn’t create a input box to mail particular records then ‘does it will take a long time to scan for entire sheet and send the mail or not?
I have also create a macro for letters using the same code. If I want to create a particular record second time if there is a request of duplicate receipt then I have to delete the remark ‘Sent’ and type ‘Send’ again to create that particular record.

Option Explicit

Sub Email()
Dim wdApp As New Word.Application, wdDoc As Word.Document, x, y As Long, BlnEx As Boolean
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
'Const strQry As String = "SELECT * FROM `Data$`"
Const strQry As String = "SELECT * FROM `Data$`  WHERE (`EMAIL` IS NULL OR `EMAIL` NOT LIKE '%-%') And `REMARK` LIKE '%Send%' OR (`EMAIL` IS NULL OR `EMAIL` = '') OR (`EMAIL` IS NULL OR `EMAIL` NOT LIKE '%-%') And `REMARK` = 'Send'"

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
With .DataSource
BlnEx = True
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 the 'Y' is greater than last entry/record number then 'y' should be the last entry/record number
    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 = x
.LastRecord = y
.ActiveRecord = x
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
'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
End Sub

Thank you for your kind guidance to teach me mail merge.

Thanking you,

The mailmerge will take about the same time to run regardless of whether you're using an input box to get the record range. Indeed, the time taken for you to input those details is likely to be far more than it would take the mailmerge for any additional processing without the input boxes. Even with input boxes, you won't be able to generate duplicates unless you also change the 'Sent' to 'Send'.

If you want to send letters, you can't use the same code: you would either have to use another macro for that or modify the existing one so you can choose between sending letters and sending emails. You'd probably also need to use a different mailmerge main document.

For code with the inputboxes, try:

Sub MergeToEmailWithPrompt()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim i As Long, x As Long, y As Long, z As Long, lRec As Long
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const strQry As String = "SELECT * FROM `Data$`  WHERE " & _
  "(`EMAIL` NOT NULL AND `EMAIL` NOT LIKE '%-%' AND `EMAIL` NOT '')" & _
  " AND (`REMARK` LIKE '%Send%' OR `REMARK` = 'Send')"
lRec = ThisWorkbook.Sheets("Data").UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
'Get the record range to merge
x = InputBox("What is the first record to merge?", , 1)
y = InputBox("What is the last record to merge?", , lRec)
If x < 1 Or y < 1 Or y < x Then Exit Sub
'If the 'Y' is greater than last record then 'y' should be the last record
If y > lRec Then y = lRec
Application.ScreenUpdating = False
With wdApp
  'Disable alerts to prevent an SQL prompt
  .DisplayAlerts = wdAlertsNone
  'Open the mail merge 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
      .MailFormat = wdMailFormatHTML
      .MailSubject = "Test Email"
      .MailAddressFieldName = "EMAIL"
      .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
      With .DataSource
        .FirstRecord = x
        .ActiveRecord = x
        .LastRecord = y
      End With
      .Execute Pause:=False
      'Disconnect from the data source
      .MainDocumentType = wdNotAMergeDocument
    End With
    'Close the mailmerge main document
    .Close False
  End With
  'Restore the Word alerts
  .DisplayAlerts = wdAlertsAll
  'Exit Word
  .Quit
End With
'Mark sent 'Send' records 'Sent'
With ThisWorkbook.Sheets("Data")
  For i = x + 1 To y + 1
    If .Range("V" & i).Value = "Send" Then
      If .Range("H" & i).Value <> "" Then
        If InStr(.Range("H" & i).Value, "-") = 0 Then
          .Range("V" & i).Value = "Sent"
          z = z + 1
        End If
      End If
    End If
  Next
End With
Application.ScreenUpdating = True
Set wdDoc = Nothing: Set wdApp = Nothing
MsgBox "Congratulations! " & z & " emails were generated successfully!", 64
End Sub

For code without the inputboxes, try:

Sub MergeToEmailNoPrompt()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim i As Long, z As Long, lRec As Long
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const strQry As String = "SELECT * FROM `Data$`  WHERE " & _
  "(`EMAIL` NOT NULL AND `EMAIL` NOT LIKE '%-%' AND `EMAIL` NOT '')" & _
  " AND (`REMARK` LIKE '%Send%' OR `REMARK` = 'Send')"
lRec = ThisWorkbook.Sheets("Data").UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
Application.ScreenUpdating = False
With wdApp
  'Disable alerts to prevent an SQL prompt
  .DisplayAlerts = wdAlertsNone
  'Open the mail merge 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
      .MailFormat = wdMailFormatHTML
      .MailSubject = "Test Email"
      .MailAddressFieldName = "EMAIL"
      .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
      With .DataSource
        .FirstRecord = 1
        .ActiveRecord = 1
        .LastRecord = lRec
      End With
      .Execute Pause:=False
      'Disconnect from the data source
      .MainDocumentType = wdNotAMergeDocument
    End With
    'Close the mailmerge main document
    .Close False
  End With
  'Restore the Word alerts
  .DisplayAlerts = wdAlertsAll
  'Exit Word
  .Quit
End With
'Mark sent 'Send' records 'Sent'
With ThisWorkbook.Sheets("Data")
  For i = 2 To lRec + 1
    If .Range("V" & i).Value = "Send" Then
      If .Range("H" &  i).Value <> "" Then
        If InStr(.Range("H" & i).Value, "-") = 0 Then
          .Range("V" & i).Value = "Sent"
          z = z + 1
        End If
      End If
    End If
  Next
End With
Application.ScreenUpdating = True
Set wdDoc = Nothing: Set wdApp = Nothing
MsgBox "Congratulations! " & z & " emails were generated successfully!", 64
End Sub

Note: I've simplified your Const strQry String. However, as SQL is not my forte, I can't guarantee it works correctly. Check the output.

Hi Paul,

Thank you very much. Now everything is covered in the code as per requirement. In the both code I am getting error as follows:
Getting run-time error 5922 word was unable to open the database Source
On the following line:

.OpenDataSource Name:=strWorkbookName, ReadOnly:=True, LinkToSource:=False, _

Yes, for letters I have another macro.

Thank you and have a nice time.

That may be because there's an error in my edit of your Const strQry String. As I said, SQL is not my forte. Try the code with your Const strQry String from post #17.

Hi Paul,

Yes, the error was in qry. After changing the qry statement the error has gone.

Now a error 1004:
run-time error 1004 application-defined or object-defined error on the following line ...

If .Range("V", i).Value = "Send" Then

Thanking you,

Oops - typos in the With ThisWorkbook.Sheets("Data") ... End With block. I've edited that part of the code in post #18. Try the updated With ThisWorkbook.Sheets("Data") ... End With block.

Hi Paul,

Greetings from me!

Excellent! Now it’s working fine as per requirement.

I have also created a macro for letters. I amended the email code and achieve the target as per requirement successfully. Only the remark ‘Send’ to ‘Sent’ and letters count message at the end is not as per requirement. I couldn’t amend it. Everything is perfect. I’m marking the thread solved now but do suggest me an amendment in the letter code positively remark and letter count problem. I have created a new letter and one more column for letter remark namely ‘REMARK L’ column ‘W’.

After a long time finally I learned mail merge, sql statement, filter with your kind guidance and sincere efforts to teach me positively. I’m thank you for the same and appreciate you by heart.

Option Explicit

Sub MergeToLetterNoPrompt()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim i As Long, z As Long, lRec As Long
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const strQry As String = "SELECT * FROM `Data$`  WHERE `REMARK L` LIKE '%Send%'"
lRec = ThisWorkbook.Sheets("Data").UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row - 1

Application.ScreenUpdating = False
With wdApp
  'Disable alerts to prevent an SQL prompt
  .DisplayAlerts = wdAlertsNone
  'Open the mail merge main document
  Set wdDoc = .Documents.Open(ThisWorkbook.Path & "\INPUT\ABC COMPANY.docx", _
    ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False)
  With wdDoc
    With .MailMerge
      'Define the mailmerge type
.MainDocumentType = wdFormLetters
      'Define the output
      .Destination = wdSendToNewDocument
      .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
      With .DataSource
        .FirstRecord = 1
        .ActiveRecord = 1
        .LastRecord = lRec
      End With
      .Execute Pause:=False
      'Disconnect from the data source
      .MainDocumentType = wdNotAMergeDocument
    End With
    'Close the mailmerge main document
    .Close False
  End With
  With .ActiveDocument
    .SaveAs Filename:=ThisWorkbook.Path & "\OUTPUT\ABC COMPANY RECEIPT" & Format(Date, "dd mmmm yyyy"), _
      FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    'Close the mailmerge output document
.Close False
End With
  'Restore the Word alerts
  .DisplayAlerts = wdAlertsAll
  'Exit Word
  .Quit
End With
'Mark sent 'Send' records 'Sent'
With ThisWorkbook.Sheets("Data")
  For i = 2 To lRec + 1
    If .Range("W" & i).Value = "Send" Then
      If .Range("H" & i).Value <> "" Then
        If InStr(.Range("H" & i).Value, "-") = 0 Then
          .Range("W" & i).Value = "Sent"
          z = z + 1
        End If
      End If
    End If
  Next
End With
Application.ScreenUpdating = True
Set wdDoc = Nothing: Set wdApp = Nothing
MsgBox "Congratulations! " & z & " letters were generated successfully!", 64
End Sub
Sub MergeToLetterWithPrompt()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim i As Long, x As Long, y As Long, z As Long, lRec As Long
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const strQry As String = "SELECT * FROM `Data$`  WHERE `REMARK L` LIKE '%Send%'"
lRec = ThisWorkbook.Sheets("Data").UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row - 1

'Get the record range to merge
x = InputBox("What is the first record to merge?", , 1)
y = InputBox("What is the last record to merge?", , lRec)
If x < 1 Or y < 1 Or y < x Then Exit Sub
'If the 'Y' is greater than last record then 'y' should be the last record
If y > lRec Then y = lRec
Application.ScreenUpdating = False
With wdApp
  'Disable alerts to prevent an SQL prompt
  .DisplayAlerts = wdAlertsNone
  'Open the mail merge main document
  Set wdDoc = .Documents.Open(ThisWorkbook.Path & "\INPUT\ABC COMPANY.docx", _
    ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False)
  With wdDoc
    With .MailMerge
      'Define the mailmerge type
      .MainDocumentType = wdFormLetters
      'Define the output
      .Destination = wdSendToNewDocument
      .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
      With .DataSource
        .FirstRecord = x
        .ActiveRecord = x
        .LastRecord = y
      End With
      .Execute Pause:=False
      'Disconnect from the data source
      .MainDocumentType = wdNotAMergeDocument
    End With
    'Close the mailmerge main document
    .Close False
  End With
  With .ActiveDocument
    .SaveAs Filename:=ThisWorkbook.Path & "\OUTPUT\ABC COMPANY RECEIPT" & Format(Date, "dd mmmm yyyy"), _
      FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    'Close the mailmerge output document
.Close False
End With
  'Restore the Word alerts
  .DisplayAlerts = wdAlertsAll
  'Exit Word
  .Quit
End With
'Mark sent 'Send' records 'Sent'
With ThisWorkbook.Sheets("Data")
  For i = x + 1 To y + 1
    If .Range("W" & i).Value = "Send" Then
      If .Range("H" & i).Value <> "" Then
        If InStr(.Range("H" & i).Value, "-") = 0 Then
          .Range("V" & i).Value = "Sent"
          z = z + 1
        End If
      End If
    End If
  Next
End With
Application.ScreenUpdating = True
Set wdDoc = Nothing: Set wdApp = Nothing
MsgBox "Congratulations! " & z & " letters were generated successfully!", 64
End Sub

Thank you and have a nice time.

Originally Posted by mso3

I have also created a macro for letters. I amended the email code and achieve the target as per requirement successfully. Only the remark ‘Send’ to ‘Sent’ and letters count message at the end is not as per requirement. I couldn’t amend it. Everything is perfect. I’m marking the thread solved now but do suggest me an amendment in the letter code positively remark and letter count problem. I have created a new letter and one more column for letter remark namely ‘REMARK L’ column ‘W’.

In that case:
• change the With ThisWorkbook.Sheets("Data") ... End With block for the MergeToLetterWithPrompt sub to:

With ThisWorkbook.Sheets("Data")
  For i = x + 1 To y + 1
    If .Range("W" & i).Value = "Send" Then
      .Range("W" & i).Value = "Sent"
      z = z + 1
    End If
  Next
End With

• change the With ThisWorkbook.Sheets("Data") ... End With block for the MergeToLetterNoPrompt sub to:

With ThisWorkbook.Sheets("Data")
  For i = 2 To lRec + 1
    If .Range("W" & i).Value = "Send" Then
      .Range("W" & i).Value = "Sent"
      z = z + 1
    End If
  Next
End With

Hi Paul,

Perfect! In this thread I learned a lot; 4 types of mail merge, filter, count message and remark. Credit goes to you for your kind guidance to teach me it patiently.

I by heart appreciate you for the same.

Thank you and have a nice time.