Only send email if contains "abcd"
Hi,
I have an emailing tool that finds files and attaches them to an email based on an email address in column L.
Can i add a line of code that means that the email cannot be sent unless the email address contains "abcd"
Many thanks
I have an emailing tool that finds files and attaches them to an email based on an email address in column L.
Can i add a line of code that means that the email cannot be sent unless the email address contains "abcd"
Many thanks
Public rng As Range, cell As Range
Sub get_data()
Dim lrow As Long
lrow = Cells(Cells.Rows.Count, "k").End(xlUp).Row
Set rng = Range("K5:K" & lrow)
For Each cell In rng
If cell.Value <> "" Then send_email cell.Value, cell.Offset(0, 1).Value
Next cell
MsgBox "Files sent"
End Sub
Sub send_email(str As String, str1 As String)
'
Dim MailDbName As String
Dim Recipient As Variant
Dim ccRecipient As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim Attachment3 As String
Dim Attachment4 As String
Dim Attachment5 As String
Dim Attachment6 As String
Dim Attachment7 As String
Dim Attachment8 As String
Dim Attachment9 As String
Dim Attachment10 As String
Dim Attachment11 As String
Dim Attachment12 As String
Dim Attachment13 As String
Dim Attachment14 As String
Dim Attachment15 As String
Dim Attachment16 As String
Dim Attachment17 As String
Dim Attachment18 As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim AttachME2 As Object
Dim AttachME3 As Object
Dim AttachME4 As Object
Dim AttachME5 As Object
Dim AttachME6 As Object
Dim AttachME7 As Object
Dim AttachME8 As Object
Dim AttachME9 As Object
Dim AttachME10 As Object
Dim AttachME11 As Object
Dim AttachME12 As Object
Dim AttachME13 As Object
Dim AttachME14 As Object
Dim AttachME15 As Object
Dim AttachME16 As Object
Dim AttachME17 As Object
Dim AttachME18 As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim EmbedObj2 As Object
Dim EmbedObj3 As Object
Dim EmbedObj4 As Object
Dim EmbedObj5 As Object
Dim EmbedObj6 As Object
Dim EmbedObj7 As Object
Dim EmbedObj8 As Object
Dim EmbedObj9 As Object
Dim EmbedObj10 As Object
Dim EmbedObj11 As Object
Dim EmbedObj12 As Object
Dim EmbedObj13 As Object
Dim EmbedObj14 As Object
Dim EmbedObj15 As Object
Dim EmbedObj16 As Object
Dim EmbedObj17 As Object
Dim EmbedObj18 As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
' Select range of e-mail addresses
Recipient = Array(str1)
MonthDate = Format(ActiveSheet.Range("O5"), "MMMM yyyy")
MailDoc.Principal = Range("R5").Value
MailDoc.SendTo = Recipient
MailDoc.Subject = "Sales Manager Horis Report " & MonthDate
Set mailbody = MailDoc.CreateRichTextItem("Body")
Call mailbody.AppendText("Please find attached your Sales Manager Horis Reports for " & MonthDate & ". ")
Call mailbody.Addnewline(1)
Call mailbody.Addnewline(1)
Call mailbody.AppendText("If you have any questions around the content of these reports, please contact your Regional SPM team in the first instance. ")
Call mailbody.Addnewline(1)
Call mailbody.Addnewline(1)
Call mailbody.AppendText("A guide to reading the Sales Dashboard can be found in the following link:")
Call mailbody.Addnewline(1)
Call mailbody.Addnewline(1)
Call mailbody.AppendText("")
Call mailbody.Addnewline(1)
Call mailbody.Addnewline(1)
Call mailbody.AppendText("If you have received this email in error, please delete and contact the regional mailbox in order for you to be removed from future monthly automated mailings.")
Call mailbody.Addnewline(2)
' Select Workbook to Attach to E-Mail
Dim stfilename1 As String, stfilename2 As String, stfilename3 As String, stfilename4 As String, stfilename5 As String, stfilename6 As String, stfilename7 As String, stfilename8 As String, stfilename9 As String, stfilename10 As String, stfilename11 As String, stfilename12 As String, stfilename13 As String, stfilename14 As String, stfilename15 As String, stfilename16 As String, stfilename17 As String, stfilename18 As String
Dim stpath As String
stpath = "R:\SPM\Horis Info\Horis_Project\GBM\" & Format(Cells(5, 15).Value, "mmm-yy") & "\Output\" & Cells(5, 13).Value & "\All"
'For Each stItem In Array("GB-CORP", "GB-FI", "CMB-LC", "MME")
' stFilenameTmp = str & " - " & stItem & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - "" .pdf"
'stFilenameTmp = str & " - " & stItem & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
'stFilenameTmp = str & " - " & stItem & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region .pdf"
'stFilenameTmp = str & " - " & stItem & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed.xlsx"
'stFilenameTmp = str & " - " & stItem & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked.xlsx"
'stFilenameTmp = str & " - " & stItem & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region.xlsx"
' If Len(Dir(stpath & "\" & stFilenameTmp)) > 0 Then
' stComp = stItem
' Exit For
' End If
'Next
stfilename1 = str & " - " & stComp & Cells(5, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
stfilename2 = str & " - " & stComp & Cells(5, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
stfilename3 = str & " - " & stComp & Cells(5, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region .pdf"
stfilename4 = str & " - " & stComp & Cells(5, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed.xlsx"
stfilename5 = str & " - " & stComp & Cells(5, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked.xlsx"
stfilename6 = str & " - " & stComp & Cells(5, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region.xlsx"
stfilename7 = str & " - " & stComp & Cells(6, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
stfilename8 = str & " - " & stComp & Cells(6, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
stfilename9 = str & " - " & stComp & Cells(6, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region .pdf"
stfilename10 = str & " - " & stComp & Cells(6, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed.xlsx"
stfilename11 = str & " - " & stComp & Cells(6, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked.xlsx"
stfilename12 = str & " - " & stComp & Cells(6, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region.xlsx"
stfilename13 = str & " - " & stComp & Cells(7, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
stfilename14 = str & " - " & stComp & Cells(7, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
stfilename15 = str & " - " & stComp & Cells(7, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region .pdf"
stfilename16 = str & " - " & stComp & Cells(7, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed.xlsx"
stfilename17 = str & " - " & stComp & Cells(7, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked.xlsx"
stfilename18 = str & " - " & stComp & Cells(7, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region.xlsx"
stfilename19 = str & " - " & stComp & Cells(8, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
stfilename20 = str & " - " & stComp & Cells(8, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
stfilename21 = str & " - " & stComp & Cells(8, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region .pdf"
stfilename22 = str & " - " & stComp & Cells(8, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed.xlsx"
stfilename23 = str & " - " & stComp & Cells(8, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked.xlsx"
stfilename24 = str & " - " & stComp & Cells(8, 22) & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region.xlsx"
MailDoc.SaveMessageOnSend = True
Attachment1 = stpath & "\" & stfilename1
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CreateRichTextItem("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "attachment1", Attachment1, "") 'Required File Name
On Error Resume Next
End If
Attachment2 = stpath & "\" & stfilename2 '"C:\YourFile.xls" ' Required File Name
If Attachment2 <> 0 Then
On Error Resume Next
Set AttachME2 = MailDoc.CreateRichTextItem("attachment2")
Set EmbedObj2 = AttachME.EmbedObject(1454, "attachment2", Attachment2, "") 'Required File Name
On Error Resume Next
End If
Attachment3 = stpath & "\" & stfilename3 '"C:\YourFile.xls" ' Required File Name
If Attachment3 <> "" Then
On Error Resume Next
Set AttachME3 = MailDoc.CreateRichTextItem("attachment3")
Set EmbedObj3 = AttachME.EmbedObject(1454, "attachment3", Attachment3, "") 'Required File Name
On Error Resume Next
End If
Attachment4 = stpath & "\" & stfilename4 '"C:\YourFile.xls" ' Required File Name
If Attachment4 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CreateRichTextItem("attachment4")
Set EmbedObj4 = AttachME.EmbedObject(1454, "attachment4", Attachment4, "") 'Required File Name
On Error Resume Next
End If
Attachment5 = stpath & "\" & stfilename5 '"C:\YourFile.xls" ' Required File Name
If Attachment5 <> 0 Then
On Error Resume Next
Set AttachME5 = MailDoc.CreateRichTextItem("attachment5")
Set EmbedObj5 = AttachME.EmbedObject(1454, "attachment5", Attachment5, "") 'Required File Name
On Error Resume Next
End If
Attachment6 = stpath & "\" & stfilename6 '"C:\YourFile.xls" ' Required File Name
If Attachment6 <> "" Then
On Error Resume Next
Set AttachME6 = MailDoc.CreateRichTextItem("attachment6")
Set EmbedObj6 = AttachME.EmbedObject(1454, "attachment6", Attachment6, "") 'Required File Name
On Error Resume Next
End If
Attachment7 = stpath & "\" & stfilename6 '"C:\YourFile.xls" ' Required File Name
If Attachment7 <> "" Then
On Error Resume Next
Set AttachME7 = MailDoc.CreateRichTextItem("attachment7")
Set EmbedObj7 = AttachME.EmbedObject(1454, "attachment7", Attachment7, "") 'Required File Name
On Error Resume Next
End If
Attachment8 = stpath & "\" & stfilename8 '"C:\YourFile.xls" ' Required File Name
If Attachment8 <> "" Then
On Error Resume Next
Set AttachME8 = MailDoc.CreateRichTextItem("attachment8")
Set EmbedObj6 = AttachME.EmbedObject(1454, "attachment8", Attachment8, "") 'Required File Name
On Error Resume Next
End If
Attachment9 = stpath & "\" & stfilename9 '"C:\YourFile.xls" ' Required File Name
If Attachment9 <> "" Then
On Error Resume Next
Set AttachME9 = MailDoc.CreateRichTextItem("attachment9")
Set EmbedObj9 = AttachME.EmbedObject(1454, "attachment9", Attachment9, "") 'Required File Name
On Error Resume Next
End If
Attachment10 = stpath & "\" & stfilename10 '"C:\YourFile.xls" ' Required File Name
If Attachment10 <> "" Then
On Error Resume Next
Set AttachME10 = MailDoc.CreateRichTextItem("attachment10")
Set EmbedObj10 = AttachME.EmbedObject(1454, "attachment10", Attachment10, "") 'Required File Name
On Error Resume Next
End If
Attachment11 = stpath & "\" & stfilename11 '"C:\YourFile.xls" ' Required File Name
If Attachment11 <> "" Then
On Error Resume Next
Set AttachME11 = MailDoc.CreateRichTextItem("attachment11")
Set EmbedObj11 = AttachME.EmbedObject(1454, "attachment11", Attachment11, "") 'Required File Name
On Error Resume Next
End If
Attachment12 = stpath & "\" & stfilename12 '"C:\YourFile.xls" ' Required File Name
If Attachment12 <> "" Then
On Error Resume Next
Set AttachME12 = MailDoc.CreateRichTextItem("attachment12")
Set EmbedObj12 = AttachME.EmbedObject(1454, "attachment12", Attachment12, "") 'Required File Name
On Error Resume Next
End If
Attachment13 = stpath & "\" & stfilename13 '"C:\YourFile.xls" ' Required File Name
If Attachment13 <> "" Then
On Error Resume Next
Set AttachME13 = MailDoc.CreateRichTextItem("attachment13")
Set EmbedObj13 = AttachME.EmbedObject(1454, "attachment13", Attachment13, "") 'Required File Name
On Error Resume Next
End If
Attachment14 = stpath & "\" & stfilename14 '"C:\YourFile.xls" ' Required File Name
If Attachment14 <> "" Then
On Error Resume Next
Set AttachME14 = MailDoc.CreateRichTextItem("attachment14")
Set EmbedObj14 = AttachME.EmbedObject(1454, "attachment14", Attachment14, "") 'Required File Name
On Error Resume Next
End If
Attachment15 = stpath & "\" & stfilename15 '"C:\YourFile.xls" ' Required File Name
If Attachment15 <> "" Then
On Error Resume Next
Set AttachME15 = MailDoc.CreateRichTextItem("attachment15")
Set EmbedObj15 = AttachME.EmbedObject(1454, "attachment15", Attachment15, "") 'Required File Name
On Error Resume Next
End If
Attachment16 = stpath & "\" & stfilename16 '"C:\YourFile.xls" ' Required File Name
If Attachment16 <> "" Then
On Error Resume Next
Set AttachME16 = MailDoc.CreateRichTextItem("attachment16")
Set EmbedObj16 = AttachME.EmbedObject(1454, "attachment16", Attachment16, "") 'Required File Name
On Error Resume Next
End If
Attachment17 = stpath & "\" & stfilename17 '"C:\YourFile.xls" ' Required File Name
If Attachment17 <> "" Then
On Error Resume Next
Set AttachME17 = MailDoc.CreateRichTextItem("attachment17")
Set EmbedObj17 = AttachME.EmbedObject(1454, "attachment17", Attachment17, "") 'Required File Name
On Error Resume Next
End If
Attachment18 = stpath & "\" & stfilename18 '"C:\YourFile.xls" ' Required File Name
If Attachment18 <> "" Then
On Error Resume Next
Set AttachME18 = MailDoc.CreateRichTextItem("attachment18")
Set EmbedObj18 = AttachME.EmbedObject(1454, "attachment18", Attachment18, "") 'Required File Name
On Error Resume Next
End If
Attachment19 = stpath & "\" & stfilename19 '"C:\YourFile.xls" ' Required File Name
If Attachment19 <> "" Then
On Error Resume Next
Set AttachME19 = MailDoc.CreateRichTextItem("attachment19")
Set EmbedObj19 = AttachME.EmbedObject(1454, "attachment19", Attachment19, "") 'Required File Name
On Error Resume Next
End If
Attachment20 = stpath & "\" & stfilename20 '"C:\YourFile.xls" ' Required File Name
If Attachment20 <> "" Then
On Error Resume Next
Set AttachME20 = MailDoc.CreateRichTextItem("attachment20")
Set EmbedObj20 = AttachME.EmbedObject(1454, "attachment20", Attachment20, "") 'Required File Name
On Error Resume Next
End If
Attachment21 = stpath & "\" & stfilename21 '"C:\YourFile.xls" ' Required File Name
If Attachment21 <> "" Then
On Error Resume Next
Set AttachME21 = MailDoc.CreateRichTextItem("attachment21")
Set EmbedObj21 = AttachME.EmbedObject(1454, "attachment21", Attachment21, "") 'Required File Name
On Error Resume Next
End If
Attachment22 = stpath & "\" & stfilename22 '"C:\YourFile.xls" ' Required File Name
If Attachment22 <> "" Then
On Error Resume Next
Set AttachME22 = MailDoc.CreateRichTextItem("attachment22")
Set EmbedObj22 = AttachME.EmbedObject(1454, "attachment22", Attachment22, "") 'Required File Name
On Error Resume Next
End If
Attachment23 = stpath & "\" & stfilename23 '"C:\YourFile.xls" ' Required File Name
If Attachment23 <> "" Then
On Error Resume Next
Set AttachME23 = MailDoc.CreateRichTextItem("attachment23")
Set EmbedObj23 = AttachME.EmbedObject(1454, "attachment23", Attachment23, "") 'Required File Name
On Error Resume Next
End If
Attachment24 = stpath & "\" & stfilename24 '"C:\YourFile.xls" ' Required File Name
If Attachment24 <> "" Then
On Error Resume Next
Set AttachME24 = MailDoc.CreateRichTextItem("attachment24")
Set EmbedObj24 = AttachME.EmbedObject(1454, "attachment24", Attachment24, "") 'Required File Name
On Error Resume Next
End If
If Dir(Attachment1) <> "" Or Dir(Attachment2) <> "" Or Dir(Attachment3) <> "" Or Dir(Attachment4) <> "" Or Dir(Attachment5) <> "" Or Dir(Attachment6) <> "" Or Dir(Attachment7) <> "" Or Dir(Attachment8) <> "" Or Dir(Attachment9) <> "" Or Dir(Attachment10) <> "" Or Dir(Attachment11) <> "" Or Dir(Attachment12) <> "" Or Dir(Attachment13) <> "" Or Dir(Attachment14) <> "" Or Dir(Attachment15) <> "" Or Dir(Attachment16) <> "" Or Dir(Attachment17) <> "" Or Dir(Attachment18) <> "" Or Dir(Attachment19) <> "" Or Dir(Attachment20) <> "" Or Dir(Attachment21) <> "" Or Dir(Attachment22) <> "" Or Dir(Attachment23) <> "" Or Dir(Attachment24) <> "" Then
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Else
Cells(cell.Row, "t").Value = "Email attachment is missing for this name"
End If
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set AttachME2 = Nothing
Set AttachME3 = Nothing
Set AttachME4 = Nothing
Set AttachME5 = Nothing
Set AttachME6 = Nothing
Set AttachME7 = Nothing
Set AttachME8 = Nothing
Set AttachME9 = Nothing
Set AttachME10 = Nothing
Set AttachME11 = Nothing
Set AttachME12 = Nothing
Set AttachME13 = Nothing
Set AttachME14 = Nothing
Set AttachME15 = Nothing
Set AttachME16 = Nothing
Set AttachME17 = Nothing
Set AttachME18 = Nothing
Set AttachME19 = Nothing
Set AttachME20 = Nothing
Set AttachME21 = Nothing
Set AttachME22 = Nothing
Set AttachME23 = Nothing
Set AttachME24 = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing
Set EmbedObj6 = Nothing
Set EmbedObj7 = Nothing
Set EmbedObj8 = Nothing
Set EmbedObj9 = Nothing
Set EmbedObj10 = Nothing
Set EmbedObj11 = Nothing
Set EmbedObj12 = Nothing
Set EmbedObj13 = Nothing
Set EmbedObj14 = Nothing
Set EmbedObj15 = Nothing
Set EmbedObj16 = Nothing
Set EmbedObj17 = Nothing
Set EmbedObj18 = Nothing
Set EmbedObj19 = Nothing
Set EmbedObj20 = Nothing
Set EmbedObj21 = Nothing
Set EmbedObj22 = Nothing
Set EmbedObj23 = Nothing
Set EmbedObj24 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set AttachME2 = Nothing
Set AttachME3 = Nothing
Set AttachME4 = Nothing
Set AttachME5 = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing
End Sub
Last Comment
ASKER CERTIFIED SOLUTION
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
ASKER
My bad, you were correct!
Visual Basic Classic
Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.
165K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
TRUSTED BY
ASKER
seamustravers@yahoo.co.uk
That email does not contain abcd yet the email is still sending with the attachments
Thanks