Results 1 to 4 of 4

Thread: Help with lotus notes macro

Threaded View

  1. #1

    Thread Starter
    New Member
    Join Date
    Jan 2011
    Posts
    1

    Help with lotus notes macro

    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
    vb Code:
    1. Private Sub CommandButton1_Click()
    2. a = 2
    3. Do While Sheet3.Cells(a, "E") <> ""
    4.     a = a + 1
    5. Loop
    6. total = a - 1
    7. Label2.Caption = "Please Wait !!! Preparing to send ..."
    8. Label3.Caption = "0% Complete"
    9. Frame1.Repaint
    10. Application.DisplayAlerts = False
    11.  
    12. Dim EmailList As Variant
    13. Dim ws, UIdoc, Session, db, uidb, NotesAttach, NotesDoc As Object
    14. Dim RichTextBody, RichTextAttachment As Object
    15. Dim StyleBold, StyleNorm, StyleUnderline, StyleFont10 As Object
    16. Dim server, mailfile, user, usersig As String
    17. Dim SubjectTxt, MsgTxt As String
    18. Dim data
    19. Dim group1, group2, group3 As String
    20. Dim ccRecipient(2) As Variant
    21. a = 2
    22. Do While Trim(Sheet3.Cells(a, "A")) <> ""
    23.     Sheet4.Cells(1, "A") = Sheet2.Cells(5, "B")
    24.     Sheet4.Cells(2, "A") = Sheet2.Cells(6, "B")
    25.     Sheet4.Cells(3, "A") = Sheet2.Cells(7, "B")
    26.     Sheet4.Cells(4, "A") = Sheet2.Cells(8, "B")
    27.     b = 1
    28.     Do While Trim(Sheet3.Cells(1, b)) <> ""
    29.         msg = Sheet4.Range("A1:A100").Replace("#" & Sheet3.Cells(1, b) & "#", Sheet3.Cells(a, b))
    30.         b = b + 1
    31.     Loop
    32.    
    33.     Sheet1.Cells(13, "B") = Sheet4.Cells(1, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
    34.     Sheet1.Cells(15, "B") = Sheet4.Cells(2, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
    35.     Sheet1.Cells(17, "B") = Sheet4.Cells(3, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
    36.     Sheet1.Cells(19, "B") = Sheet4.Cells(4, "A") '& Sheet4.Cells(2, "A") & Sheet4.Cells(3, "A")
    37.     ccRecipient(0) = ""
    38.     ccRecipient(1) = ""
    39.     If CheckBox1.Value = True And Trim(Sheet3.Cells(a, "F")) <> "" Then ccRecipient(0) = Trim(Sheet3.Cells(a, "F"))
    40.     If CheckBox2.Value = True And Trim(Sheet3.Cells(a, "G")) <> "" Then ccRecipient(1) = Trim(Sheet3.Cells(a, "G"))
    41.     Set ws = CreateObject("Notes.NotesUIWorkspace")
    42.     Set Session = CreateObject("Notes.NotesSession")
    43.    
    44.     user = Session.UserName
    45.     usersig = Session.CommonUserName
    46.     server = Session.GetEnvironmentString("MailServer", True)
    47.     mailfile = Session.GetEnvironmentString("MailFile", True)
    48.    
    49.     Set db = Session.GETDATABASE(server, mailfile)
    50.     Set uidb = ws.CURRENTDATABASE
    51.     Set NotesDoc = db.CreateDocument
    52.        
    53.     Set RichTextBody = NotesDoc.CREATERICHTEXTITEM("Body")
    54.     MyAttachment = ""
    55.     If MyAttachment <> "" Then
    56.         Set RichTextAttachment = NotesDoc.CREATERICHTEXTITEM("Attachment")
    57.         Set NotesAttach = RichTextAttachment.EMBEDOBJECT(1454, "", MyAttachment)
    58.     End If
    59.     NotesDoc.Subject = Sheet2.Range("B1").Value
    60.     NotesDoc.sendto = Sheet3.Range("E" & a).Value
    61.     NotesDoc.copyto = ccRecipient
    62.     Set UIdoc = ws.editdocument(True, NotesDoc)
    63.     Sheet1.Range("A1:O37").Select
    64.     Selection.Copy
    65.     Call UIdoc.GotoField("Body")
    66.     Call UIdoc.Paste
    67.     Call UIdoc.Save
    68.     Set NotesDoc = UIdoc.DOCUMENT
    69.     Call NotesDoc.Save(True, True)
    70.     NotesDoc.SaveMessageOnSend = True
    71.     NotesDoc.PostedDate = Now()
    72.     NotesDoc.Send(False)
    73.    
    74.     Set Session = Nothing
    75.     Set db = Nothing
    76.     Set NotesAttach = Nothing
    77.     Set UIdoc = Nothing
    78.     Set ws = Nothing
    79.     Label2.Caption = (a - 1) & " Mails sent SuccessFully ...."
    80.     Label3.Caption = Int((a - 1) * 100 / (total - 1)) & "% Complete"
    81.     Label7.Width = Int((Label5.Width * (a - 1)) / (total - 1))
    82.     Frame1.Repaint
    83.     a = a + 1
    84. Loop
    85. Application.DisplayAlerts = True
    86. Label3.Caption = "100% Complete"
    87. msg = MsgBox((a - 2) & " Mails sent SuccessFully ...", vbOKOnly + vbInformation, "Confirmation ...")
    88. Label3.Caption = ""
    89. End Sub
    90.  
    91. Private Sub CommandButton2_Click()
    92. Unload Me
    93. End Sub
    94.  
    95. Private Sub UserForm_Initialize()
    96. a = 2
    97. Do While Sheet3.Cells(a, "E") <> ""
    98.     a = a + 1
    99. Loop
    100. Label2.Caption = a - 2 & " Mails ready to be sent"
    101. Label3.Caption = ""
    102. Label7.Width = 1
    103. Label7.Left = Label5.Left
    104. End Sub
    Last edited by Hack; Jan 21st, 2011 at 09:36 AM. Reason: Added Highlight Tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width