Help With Emailing Macros for Lotus Notes

Hi I have a mailing macros that sends different text from an excel workbook to different receipiets in a loop sequence. The problem occurs that after sending the email it opens up multiple windows which is equal to the no of emails sent. Please help...the is below

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