Hi Kim,
can you please share your excel file?
On Wed, Nov 20, 2013 at 1:05 AM, Kim McLaughlin <kmclaug...@gmail.com>wrote:
>
>
> 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.
>
--
Regards,
Anoop
Sr. Developer
Facebook ID - https://www.facebook.com/anooop.k.sharma
--
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.
