"Send Email" macro to multiple addresses

[LKP]

I am trying to get a send email button to send emails to multiple addresses.
I can get it to work for one address, but I don't know how to do multiples.
Here's the code:

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

With wb2
On Error Resume Next
.SendMail "(e-mail address removed)", _
"Product"
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True

Can anyone help?

Also, when I click on this button, a security warning pops up asking if I
want to enable the macros, which I do. How do I turn that pop up off?

 

[Ron de Bruin]

Hi LKP

See
http://www.rondebruin.nl/mail/tips1.htm

 

[LKP]

Sweet! Thanks Ron!

Hi LKP

See
http://www.rondebruin.nl/mail/tips1.htm

 

[Ron de Bruin]

Oops

Also, when I click on this button, a security warning pops up asking if I

You can change the security

Use the shortcut to go to that dialog

Alt tms

 

[LKP]

Thanks, Ron. Do you know how I can make a mcaro button conditional? I want
this "Send Email" button to one person if certain conditions are met and
another person if these conditions are not met.

 

[Ron de Bruin]

You can use code like this in the macro to test a cell value


Dim ToStr As String

If LCase(Range("A1").Value) = "yes" Then
ToStr = "(e-mail address removed)"
Else
ToStr = "(e-mail address removed)"
End If

With wb2
On Error Resume Next
.SendMail ToStr, _
"Product"
On Error GoTo 0
.Close SaveChanges:=False
End With

 

[LKP]

Great, Ron. I think that will work. The variable I am looking for is if a
cell says "Exceeds a Threshold". How would I put this into the code? Also,
if I need to send to multiple addresses, can I use the array feature you
showed me earlier?

Thanks

 

[Ron de Bruin]

Try this

With wb2
On Error Resume Next
If LCase(Range("A1").Value) = "exceeds a threshold" Then
.SendMail Array("(e-mail address removed)", "(e-mail address removed)"), _
"This is the Subject line"
Else
.SendMail Array("(e-mail address removed)", "(e-mail address removed)"), _
"This is the Subject line"
End If
On Error GoTo 0
.Close SaveChanges:=False
End With

 

[LKP]

Ron-

You are a genius! Thank you so much. It works perfectly.

 

[Ron de Bruin]

You are welcome

 

[LKP]

Sorry. I have another question. Is there a way to make the email screen
appear when someone hits the macro button so they can write a message instead
of just automatically sending the email?

 

[Ron de Bruin]

Do you use Outlook or Outlook Express or Windows Mail ?

 

[Ron de Bruin]

Then use The Outlook object model examples on my site
http://www.rondebruin.nl/sendmail.htm

You can use .Display instead of .Send in the code then

 

[LKP]

Hi Ron-

The code I have is not working. Here is what I did: Any suggestions?
Thanks!

Private Sub CommandButton1_Click()
'Working in 2000-2007
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no
VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) -
InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
If LCase(Range("C110").Value) = "exceeds a threshold" Then
.DisplayMail Array("(e-mail address removed)",
"(e-mail address removed)"), _
"CareTracker Pricing"
Else
.DisplayMail Array("(e-mail address removed)"), _
"CareTracker Pricing"
End With
On Error GoTo 0
wb2.Close SaveChanges:=False



'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[Ron de Bruin]

Use it like this

Sub test()
'Working in 2000-2007
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
If LCase(Range("C110").Value) = "exceeds a threshold" Then
.To = "(e-mail address removed);[email protected]"
Else
.To = "(e-mail address removed)"
End If
.CC = ""
.BCC = ""
.Subject = "CareTracker Pricing"
.Body = "Hi there"
.Attachments.Add wb2.FullName
.Display
End With
On Error GoTo 0

wb2.Close SaveChanges:=False

'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[LKP]

Great! It works perfectly. Thanks again!

Use it like this

Sub test()
'Working in 2000-2007
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Set wb1 = ActiveWorkbook

If Val(Application.Version) >= 12 Then
If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
If LCase(Range("C110").Value) = "exceeds a threshold" Then
.To = "(e-mail address removed);[email protected]"
Else
.To = "(e-mail address removed)"
End If
.CC = ""
.BCC = ""
.Subject = "CareTracker Pricing"
.Body = "Hi there"
.Attachments.Add wb2.FullName
.Display
End With
On Error GoTo 0

wb2.Close SaveChanges:=False

'Delete the file
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub