S Jha
S Jha

Reputation: 1

VBA for mail merge with dynamic loop with where condition

I have to make mail merge letter from my excel database. In my data total records are 10 ( but it is dynamic in nature). I have to make letters Branch Wise. In my data there is 3 records of BRCODE 470, 2 records are of BRCOD- 511, 2 records are BRCODE-517, one records of each BRCODE 52A,51K and 531. I have written a VBA in which letter is prepared with BRCODE 470. Now I want

  1. Saved filename with in same filepath with BRCODE.DOCX
  2. 6 Output documents (as per no of different BRCODE). In each output documents, records of same BRCODE get merged. for example one documents having 3 letters of BRCODE 470, one document having 2 letters of BRCODE 517 and so on.

MY VBA CODE is given below. Now what should I modify, please help.

MAIL_MERGE is my folder and Source.xlsx is my excel file and Data1 is my Sheet.

Sub MAIL_MERGE()
'
' MAIL_MERGE Macro
'
'

    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "C:\Users\123\Desktop\MAIL_MERGE\Source.xlsx", _
        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=C:\Users\sachidanand.jha\Desktop\MAIL_MERGE\Source.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:" _
        , SQLStatement:="SELECT * FROM `Data1$` WHERE `BRCODE`='470' ", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .firstrecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
    ChangeFileOpenDirectory "C:\Users\sachidanand.jha\Desktop\MAIL_MERGE\"
    ActiveDocument.SaveAs FileName:="ABC.docx", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    ActiveWindow.Close
End Sub


Upvotes: 0

Views: 114

Answers (0)

Related Questions