Help with lotus notes macro

[sankalpm]

Hi I have a emailing macro that sends email to various receipts. The problem is that after sending the email there are multiple windows that are opened up and I am not able to bypass them...Please help

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

[Hack]

Moved From The VB6 CodeBank (which is for sharing code rather than asking questions )

[opus]

You use an LotusNotes object for Mail, I'd use only one object to send each Mail ,one after the other!

[dmaruca]

This needs to be moved outside of the loop to the top of the sub.

Set ws = CreateObject("Notes.NotesUIWorkspace")
Set Session = CreateObject("Notes.NotesSession")