C
Curt
Have the following code. When used to send e-mails. I get a window for each
e-mail saying it is being sent auto and do I want it to do this. How can I
have it send all e-mails auto without asking on each one.
Thanks for assistance
'Send E-Mails
Private Sub OptionButton9_Click()
OptionButton9.Value = False
UserForm4_Letters.Hide
Sheets("Data").Select
Dim OutApp As Object
Dim OutMail As Object
Dim cell As range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
For Each cell In
Sheets("Data").Columns("K").Cells.specialcells(xlcelltypeconstants)
If cell.Value Like "?*@?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
..To = cell.Value
..subject = "Parade Reminder"
..Body = "Dear: Partcipant " & cell.Offset(0, -1).Value & vbNewLine &
vbNewLine & _
"The attachment is for FYI."
'You can add files also like this
..Attachments.Add ("\Parade\E-mail Attachment Letter.doc")
..Send
'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
e-mail saying it is being sent auto and do I want it to do this. How can I
have it send all e-mails auto without asking on each one.
Thanks for assistance
'Send E-Mails
Private Sub OptionButton9_Click()
OptionButton9.Value = False
UserForm4_Letters.Hide
Sheets("Data").Select
Dim OutApp As Object
Dim OutMail As Object
Dim cell As range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
For Each cell In
Sheets("Data").Columns("K").Cells.specialcells(xlcelltypeconstants)
If cell.Value Like "?*@?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
..To = cell.Value
..subject = "Parade Reminder"
..Body = "Dear: Partcipant " & cell.Offset(0, -1).Value & vbNewLine &
vbNewLine & _
"The attachment is for FYI."
'You can add files also like this
..Attachments.Add ("\Parade\E-mail Attachment Letter.doc")
..Send
'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub