Outlook Macro Help

[maxx_daddy]

hi smart peoples. I am trying to automate a response system for following up on quotes. This is working with the lone exception that my second followup is cramming the first and second e-mail into one long e-mail...... is there a simple way that I have missed in my code or is the correct solution to make a macro for each different e-mail that I wish to send.

Sub SendEmail()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
Dim Msg2 As String

'Create Outlook object
Set OutlookApp = New Outlook.Application
'Loop through the rows

For Each cell In Columns("e").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr2 = EmailAddr2 & ";" & cell.Value
End If
Next
Msg = Msg & "Good Morning!!" & vbCrLf & vbCrLf & "Just making sure you got the quote we sent out. When you get a moment, give me a call and we’ll go over it together." & vbCrLf & "If it looks good, just sign and send it back, and we’ll get it going for you right away." & vbCrLf & vbCrLf & "Thanks!" & vbCrLf & vbCrLf & "Joe Nelson" & vbCrLf & "Rinderle Door Company" & vbCrLf & "Phone (262)-662-5200" & vbCrLf & "Fax (262) 662-5295" & vbCrLf & "E-mail joe@rinderledoor.com"
Subj = "Just making sure we're all good....."

'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr1
.BCC = EmailAddr2
.Subject = Subj
.BodyFormat = 2
.Body = Msg & vbCrLf
.Display
.Send
End With

'Create Outlook object
Set OutlookApp = New Outlook.Application
'Loop through the rows

For Each cell In Columns("f").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr2 = EmailAddr2 & ";" & cell.Value
End If
Next
Msg2 = Msg & "Good Morning!" & vbCrLf & vbCrLf & "Hopefully you got the quote we sent out." _
& vbCrLf & "We are looking forward to working with you on this project." _
& vbCrLf & "Any questions, give me a call!" & vbCrLf & vbCrLf & "Thanks!" & vbCrLf & vbCrLf _
& "Joe Nelson" & vbCrLf & "Rinderle Door Company" & vbCrLf & "Phone (262)-662-5200" & vbCrLf & _
"Fax (262) 662-5295" & vbCrLf & "E-mail joe@rinderledoor.com"
Subj = "It's your turn......"

'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr1
.BCC = EmailAddr2
.Subject = Subj
.BodyFormat = 2
.Body = Msg2 & vbCrLf
.Display
.Send
End With


End Sub



thanks, MAXXDADDY

 

[maxx_daddy]

Re: Excel to Outlook Macro Help

Hi it's Maxx again,
I got it working by making 3 macros and putting them all on one command button, now I have another question. When there is a day that nobody gets an e-mail I get a runtime error, how can i adjust my code to skip an e-mail if there are no recipients?

Sub SendEmail()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
Dim Msg2 As String

'Create Outlook object
Set OutlookApp = New Outlook.Application
'Loop through the rows

For Each cell In Columns("e").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr2 = EmailAddr2 & ";" & cell.Value
End If
Next
Msg = Msg & "Good Morning!!" & vbCrLf & vbCrLf & "Just making sure you got the quote we sent out. When you get a moment, give me a call and we’ll go over it together." & vbCrLf & "If it looks good, just sign and send it back, and we’ll get it going for you right away." & vbCrLf & vbCrLf & "Thanks!" & vbCrLf & vbCrLf & "Joe Nelson" & vbCrLf & "Rinderle Door Company" & vbCrLf & "Phone (262)-662-5200" & vbCrLf & "Fax (262) 662-5295" & vbCrLf & "E-mail joe@rinderledoor.com"
Subj = "Just making sure we're all good....."

'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr1
.BCC = EmailAddr2
.Subject = Subj
.BodyFormat = 2
.Body = Msg & vbCrLf
.Display
.Send
End With

End Sub

 

[daverunt]

Hi you could try checking to see if the email address length = 0

EmailAddr2 = EmailAddr2 & ";" & cell.Value
End If
Next
 
If Len(EmailAddr2) = 0 Then
Msg Box("No recipients")
Exit Sub
End If
Msg

 

[maxx_daddy]

Slight Change to the Msg Box -> msgBox
other than that this works perfectly and as always.
Thank you smart people for making us less educated people look good!

Joe
(Maxx's Daddy)

Hi you could try checking to see if the email address length = 0

EmailAddr2 = EmailAddr2 & ";" & cell.Value
End If
Next
 
If Len(EmailAddr2) = 0 Then
MsgBox("No recipients")
Exit Sub
End If
Msg