Stumped! Help much appreciated

[cullenst]

Hello all,

I'm working on a macro that:
- reads an excel column of email addresses
- sends an email through Outlook to 5 of them at a time, bcc'd
- waits 60 seconds before moving on to the next 5 email addresses
- repeats this operation until the end of the column has been reached

This is a little outside of my current level of experience, and I'm stumped at this point. Any tips would be greatly appreciated!

I've included the macro below:

Sub SendOutlookMessages()

'TODO: Work in the application wait and loop until functions. Remove the xrecipient operation that adds multiple recipients.
'      Determine the function of ToRangeCounter. Add random interval wait, or script several irregular intervals before looping.
'
 row_number = row_number + 1
 Dim count As Integer
 Dim OL As Object, MailSendItem As Object
 Dim W As Object
 Dim MsgTxt As String, SendFile As String
 Dim ToRangeCounter As Variant
' This prompts for the MS word file that will be the body of the email.


 SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
     "file to mail, then click 'Open'", buttontext:="Send", _
     MultiSelect:=False)


Set W = GetObject(SendFile)
  MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
    End:=W.Paragraphs(W.Paragraphs.count).Range.End)
  Set W = Nothing


' Next tells outlook to create a new email


 Set OL = CreateObject("Outlook.Application")
 Set MailSendItem = OL.CreateItem(olMailItem)
 ToRangeCounter = 0


' Next defines the email recipients, but does not add them to the email. It will be referred to by another operation later.
' ADD MAILSEND OPERATION HERE BEFORE NEXTCELL?


 For Each xCell In ActiveSheet.Range(Range("O7"), _
     Range("O7").End(xlDown))
     ToRangeCounter = ToRangeCounter + 1
 Next xCell


' This bit below limits recipients to 256 cells in the excel workbook column?


 If ToRangeCounter = 256 Then ToRangeCounter = 1


' Next bit defines parameters of email being sent, including subject, body, and recipients.


With MailSendItem
     .Subject = ActiveSheet.Range("AC1").Text
     .Body = MsgTxt


' This section below needs to be changed in order to send to one recipient at a time.
' IN PROGRESS.




     For Each xRecipient In Range("O7").Resize(ToRangeCounter, 1)
         RecipientList = RecipientList & ActiveCell
     
     .Bcc = ActiveCell.Select
     .Send
     Application.Wait DateAdd("s", 60, Now)
     Next xRecipient
     Do
     Loop Until row_number = 15
 End With


 Set OL = Nothing


End Sub

Thanks for reading!

S

 

[cullenst]

Bump. Open to any suggestions!

Thanks again.