I have a spreadsheet with columns A through AD and have about 1000 rows on
my report. I need to run the report every month and send an email to anyone
that has a greater than or equal to 6 in Column "W". If column "W" is
greater than or equal to 6, then click a "send emails" button with an
attachment of the worksheet to email recipients in column "P" via Lotus
Notes. (There would be multiple addresses, and each month would be
different depending on the criteria.) Also if the criteria does not match
the 6, then delete the row, and always save a copy of the worksheet to my
"C" drive.
The code for the email with the subject, body text and attachment are
working, but I am having trouble with selecting the range from the
spreadsheet to send to the recipients and adding my signature to the end.
Any help on this would be greatly appreciated! Thanks in advance.
Option Explicit
Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "C:"
Sub Send_Active_Sheet()
Dim stFileName As String
Dim Worksheets As Variant
Set Worksheets = Sheets("FabricsProjectList")
Dim myDocument As Range
Dim rng As Range
Dim vaRecipients As String
Dim vaCopyTo As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim stSubject As Variant
Dim vaMsg As Variant
Dim x As Integer
Dim c As Range
Dim i As Long
Dim lRow As Long
Dim lCol As Long
Dim UserName As String
Dim MailDbName As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = .Range("A1").Value
End With
' Select range of e-mail addresses
Worksheets("FabricsProjectList").Range("P6", "P1000").Value
For i = 7 To Range("A" & Rows.Count).End(3)(2).Row
' Cells.Range ("W6:W1000")
If Cells(i, "W:W") >= 6 Then
With Cells(i, "P:P")
vaRecipients = Worksheets("FabricsProjectList").Range("P" & i).Value
.SendTo = vaRecipients
stSubject = "Hi, Enterprise Project Champion," & vbCrLf & "This is just a
FYI - the last review of your Enterprise Project is older than 6 months...which
one ? Please see audit list attached ..."
vaMsg = "Hi," & vbCrLf & vbCrLf & "What I am looking for...... the reason
for this reminder" & vbCrLf & vbCrLf & "It is my commitment" & vbCrLf & vbCrLf
& "To run an audit every month" & vbCrLf & "To find out which projects are not
in the regular review process (6 months)" & vbCrLf & "To send out this info to
the champions and R&D leaders" & vbCrLf & vbCrLf & "Please be so kind and let
me know if there have been RWW's/ reviews in the meantime. If Yes, please send
me the documentation." & vbCrLf & vbCrLf & "We will enter the document and the
new last review date into the database." & vbCrLf & vbCrLf & "Thank you"
stSignature =
Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
stAttachment = stPath & "PROJECT TIME TRACKING\2013 Time Tracking
Reports" & stFileName & "Fabrics R&D Time Tracking Reports_Sep2013_rev2.xls"
End With
'Save and close the temporarily workbook.
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CREATEDOCUMENT
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "",
stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.SEND 0, vaRecipients
End With
'Delete the temporarily workbook.
Kill stAttachment
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
MsgBox "Congratulations! The e-mail has successfully been created and
distributed", vbInformation
End If
Next i
End With
End Sub
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at http://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/groups/opt_out.
