Loop to email one row of data to an email address
I am trying to create a macro that will send the header row (a1:p1) with a second row of data for a different email addresses. Mail being sent thru lotus. MSOffice 2007.
Email address for recipient is located in column Q. I want to create a loop (currently a counter) the will send and email to the address located in cell Qs, with the data contained on the same row A thru P.
My first obstacle was to get an email generated with data from excel and send. I found the code in this forum. I have been trying to figure out how to loop thru each row. I am attempting to use a counter. This may not be the best because I really just like to start sending data from row 2, 3 .... until no data exist. right now it is coded to send the data from rows 2 thru 5.
But. currently I have some type of code issue in red below; (run-time error '1004'application defined or object defined error). I have never coded in vba and am pretty sure it is a syntax issue.
.FieldSetText "EnterSendTo", Sheets("Sheet1").Range(Q, counter).Value
Any thoughts regarding this code? I really appreciate insight because this macro will streamline my job.
thanks in advance. love this forum.
Sub Email_Excel_Cells()
Dim NSession As Object
Dim NUIWorkSpace As Object
Dim NDoc As Object
Dim NUIdoc As Object
Dim Email ' add new dim
Dim counter As Integer
Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
For counter = 2 To 5
Set NDoc = NUIWorkSpace.ComposeDocument("", "", "Memo")
Set NUIdoc = NUIWorkSpace.CURRENTDOCUMENT
With NUIdoc
.FieldSetText "EnterSendTo", Sheets("Sheet1").Range(Q, counter).Value
.FieldSetText "EnterCopyTo", ""
.FieldSetText "Subject", "Quarterly Supplier Performance " & Now
.FieldSetText "Body", "Excel cells are pasted below this text" & vbNewLine & vbNewLine & _
"**PASTE EXCEL CELLS HERE**" & vbNewLine & vbNewLine & _
"Excel cells are pasted above this text"
.GotoField ("Body")
.FINDSTRING "**PASTE EXCEL CELLS HERE**"
Sheets("Sheet1").Range("A1:p1").Copy 'the cells to copy and paste
.Paste
Application.CutCopyMode = False
Sheets("Sheet1").Range(Cells(a, counter), Cells(p, counter)).Copy 'the cells to copy and paste
.Paste
Application.CutCopyMode = False
.Send
.Close
End With
Next counter
Set NUIdoc = Nothing
Set NDoc = Nothing
Set NUIWorkSpace = Nothing
Set NSession = Nothing
End Sub
Bookmarks