Microsoft Office Tutorials and References
In Depth Information
Sending a Message Individually to Multiple Recipients
'Declaring this object variable in this section¶
'to make its lifetime along this application¶
'to recognize the active sheet that code¶
'started working with¶
Dim sht As Worksheet¶
' * * * * *¶
Sub SendEmail()¶
'Outlook Application Objects declaration¶
Dim objMail As Object 'Outlook.MailItem¶
'Excel Application Objects declaration¶
Dim rng As Range¶
Dim cll As Range¶
'Validate if this is the first attempt¶
'to run this procedure¶
'If first attempt then ask user to¶
'select a mail item to send¶
If objItem Is Nothing Then¶
Call SetMailItem¶
End If¶
'Mail item cannot be set¶
'Stop execution¶
If objItem Is Nothing Then Exit Sub¶
'Set worksheet object¶
'Considering active sheet is being used¶
'If it has been set during previous attempt to run¶
'this module then skip it¶
If sht Is Nothing Then¶
Set sht = ActiveSheet¶
End If¶
'Set range that includes email addresses - Column A¶
Set rng = sht.Range(sht.Cells(2, 1), _¶
sht.Cells(65536, 1).End(xlUp))¶
If rng.Cells(1, 1).Row = 1 Then Exit Sub¶
'Inform user about progress¶
Application.StatusBar = "Remaining " & _¶
(rng.Rows.Count - howMany) & " addresses : " & _¶
Int(rng.Rows.Count / howMany * myInterval / 60) _¶
& " minutes..."¶
'If the selected range has a row count more than the number¶
'of emails to be delivered then reselect the range by using¶
'exact number of rows indicated by the howMany variable value¶
If rng.Rows.Count > howMany Then¶
Set rng = sht.Range(sht.Cells(2, 1), _¶
sht.Cells(howMany + 1, 1))¶
End If¶
'Send every single user an email message¶
For Each cll In rng.Rows¶
If Trim(cll.Value) <> "" Then¶
Set objMail = objItem.Copy¶
objMail.To = cll.Cells(1, 1).Value¶
objMail.Send¶
Out
Search JabSto ::




Custom Search