Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Column G Column W
- File1.xls recipient1@email.com
- File2.xls recipient2@email.com
- File3.xls recipient3@email.com
- File4.xls recipient4@email.com
- End with without with
- End With
- Sub email()
- 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
- 'Working in Office 2000-2016
- 'Variables
- Dim cell As Range
- Application.ScreenUpdating = False
- Dim Maildb As Object
- Dim MailDoc As Object
- Dim Body As Object
- Dim Session As Object
- 'Start a session of Lotus Notes
- Set Session = CreateObject("Lotus.NotesSession")
- 'This line prompts for password of current ID noted in Notes.INI
- Call Session.Initialize
- 'or use below to provide password of the current ID (to avoid Password prompt)
- 'Call Session.Initialize("<password>")
- 'Open the Mail Database of your Lotus Notes
- Set Maildb = Session.GETDATABASE("", "D:NotesdataMaileXceLiTems.nsf")
- If Not Maildb.IsOpen = True Then
- Call Maildb.Open
- End If
- 'Loop
- On Error GoTo cleanup
- For Each cell In Columns("V").Cells.SpecialCells(xlCellTypeConstants)
- If cell.Value Like "?*@?*.?*" And _
- LCase(Cells(cell.Row, "G").Value) <> "" Then
- 'Email COde
- Set MailDoc = Maildb.CREATEDOCUMENT
- Call MailDoc.REPLACEITEMVALUE("Form", "Memo")
- 'Set the Recipient of the mail
- Call MailDoc.REPLACEITEMVALUE("SendTo", cell.Value)
- 'Set subject of the mail
- Call MailDoc.REPLACEITEMVALUE("Subject", "Attention Required: Promotion Announcement for Week " & Range("O10").Value & " " & Range("O13").Value)
- 'Create and set the Body content of the mail
- Set Body = MailDoc.CREATERICHTEXTITEM("Body")
- 'Email Body
- Call Body.APPENDTEXT("Good " & Range("A1").Value & "," _
- & vbNewLine & vbNewLine & _
- "Thank you for your interest in participating in this weeks special promotion. Please see the details below." _
- & vbNewLine & vbNewLine _
- & vbNewLine & vbNewLine _
- & Range("I10").Value _
- & vbNewLine & vbNewLine _
- & "Thank you and kind regards / Danke und freundliche GrΓΌΓe," _
- & vbNewLine & vbNewLine _
- & "The Food Specials Team" _
- & vbNewLine)
- 'End Email Body
- 'Example to create an attachment (optional)
- Call Body.ADDNEWLINE(2)
- Call Body.EMBEDOBJECT(1454, "", Filename, cell.Offset(0, -19).Value)
- 'Example to save the message (optional) in Sent items
- MailDoc.SAVEMESSAGEONSEND = True
- 'Send the document
- 'Gets the mail to appear in the Sent items folder
- Call MailDoc.REPLACEITEMVALUE("PostedDate", Now())
- Call MailDoc.SEND(True)
- 'Clean Up the Object variables - Recover memory
- 'End Loop
- End With
- On Error GoTo 0
- Set OutMail = Nothing
- End If
- Next cell
- cleanup:
- Set Maildb = Nothing
- Set MailDoc = Nothing
- Set Body = Nothing
- Set Session = Nothing
- Application.ScreenUpdating = True
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement