Private Sub CommandButton1_Click()
a = 2
Do While Sheet3.Cells(a, "E") <> ""
a = a + 1
Loop
total = a - 1
Label2.Caption = "Please Wait !!! Preparing to send ..."
Label3.Caption = "0% Complete"
Frame1.Repaint
Application.DisplayAlerts = False
Dim EmailList As Variant
Dim ws, UIdoc, Session, db, uidb, NotesAttach, NotesDoc As Object
Dim RichTextBody, RichTextAttachment As Object
Dim StyleBold, StyleNorm, StyleUnderline, StyleFont10 As Object
Dim server, mailfile, user, usersig As String
Dim SubjectTxt, MsgTxt As String
Dim data
Dim group1, group2, group3 As String
Dim ccRecipient(2) As Variant
a = 2
Do While Trim(Sheet3.Cells(a, "A")) <> ""
Sheet4.Cells(1, "A") = Sheet2.Cells(5, "B")
Sheet4.Cells(2, "A") = Sheet2.Cells(6, "B")
Sheet4.Cells(3, "A") = Sheet2.Cells(7, "B")
Sheet4.Cells(4, "A") = Sheet2.Cells(8, "B")
b = 1
Do While Trim(Sheet3.Cells(1, b)) <> ""
msg = Sheet4.Range("A1:A100").Replace("#" & Sheet3.Cells(1, b) & "#", Sheet3.Cells(a, b))
b = b + 1
Loop
Sheet1.Cells(13, "B") = Sheet4.Cells(1, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
Sheet1.Cells(15, "B") = Sheet4.Cells(2, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
Sheet1.Cells(17, "B") = Sheet4.Cells(3, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
Sheet1.Cells(19, "B") = Sheet4.Cells(4, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
ccRecipient(0) = ""
ccRecipient(1) = ""
If CheckBox1.Value = True And Trim(Sheet3.Cells(a, "F")) <> "" Then ccRecipient(0) = Trim(Sheet3.Cells(a, "F"))
If CheckBox2.Value = True And Trim(Sheet3.Cells(a, "G")) <> "" Then ccRecipient(1) = Trim(Sheet3.Cells(a, "G"))
Set ws = CreateObject("Notes.NotesUIWorkspace")
Set Session = CreateObject("Notes.NotesSession")
user = Session.UserName
usersig = Session.CommonUserName
server = Session.GetEnvironmentString("MailServer", True)
mailfile = Session.GetEnvironmentString("MailFile", True)
Set db = Session.GETDATABASE(server, mailfile)
Set uidb = ws.CURRENTDATABASE
Set NotesDoc = db.CreateDocument
Set RichTextBody = NotesDoc.CREATERICHTEXTITEM("Body")
MyAttachment = ""
If MyAttachment <> "" Then
Set RichTextAttachment = NotesDoc.CREATERICHTEXTITEM("Attachment")
Set NotesAttach = RichTextAttachment.EMBEDOBJECT(1454, "", MyAttachment)
End If
NotesDoc.Subject = Sheet2.Range("B1").Value
NotesDoc.sendto = Sheet3.Range("E" & a).Value
NotesDoc.copyto = ccRecipient
Set UIdoc = ws.editdocument(True, NotesDoc)
Sheet1.Range("A1:O37").Select
Selection.Copy
Call UIdoc.GotoField("Body")
Call UIdoc.Paste
Call UIdoc.Save
Set NotesDoc = UIdoc.DOCUMENT
Call NotesDoc.Save(True, True)
NotesDoc.SaveMessageOnSend = True
NotesDoc.PostedDate = Now()
NotesDoc.Send(False)
Set Session = Nothing
Set db = Nothing
Set NotesAttach = Nothing
Set UIdoc = Nothing
Set ws = Nothing
Label2.Caption = (a - 1) & " Mails sent SuccessFully ...."
Label3.Caption = Int((a - 1) * 100 / (total - 1)) & "% Complete"
Label7.Width = Int((Label5.Width * (a - 1)) / (total - 1))
Frame1.Repaint
a = a + 1
Loop
Application.DisplayAlerts = True
Label3.Caption = "100% Complete"
msg = MsgBox((a - 2) & " Mails sent SuccessFully ...", vbOKOnly + vbInformation, "Confirmation ...")
Label3.Caption = ""
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
a = 2
Do While Sheet3.Cells(a, "E") <> ""
a = a + 1
Loop
Label2.Caption = a - 2 & " Mails ready to be sent"
Label3.Caption = ""
Label7.Width = 1
Label7.Left = Label5.Left
End Sub
