Link to home
Start Free TrialLog in
Avatar of Seamus2626
Seamus2626Flag for Ireland

asked on

If no attachment, dont send email - lotus notes/vba

Hi,

Attached is some code that finds files based on a list of names and attaches files.

Sometimes the files don't attach for various reasons, can I add a line of code that will not send the email unless there is an attachment and return to excel the list of names that didn't send

So the code loops down Col K checking names and then looks to find a file associated with that name.

e.g Bloggs, Joe is in K4, email is prepared, but there is no attachment,  I would like the code not to send mail and return the name value in K4 to T4 and so on with any names in K that have no attachment

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 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 Session As Object
Dim EmbedObj1 As Object
Dim EmbedObj2 As Object
Dim EmbedObj3 As Object
Dim EmbedObj4 As Object
Dim EmbedObj5 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)
MailDoc.Principal = "EU SPM@hsbc.com"
MailDoc.SendTo = Recipient
MailDoc.Subject = "Sales Manager Horis Reporting"
MailDoc.Body = _
"Attached"
' Select Workbook to Attach to E-Mail

Dim stfilename1 As String, stfilename2 As String, stfilename3 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"

    stfilename1 = str & " " & Cells(5, 14).Value & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed Region .pdf"
    stfilename2 = str & " " & Cells(5, 14).Value & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    stfilename3 = str & " " & Cells(5, 14).Value & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booking .pdf"

    

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

MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient

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
.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

  

Open in new window

Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

When you have this line...

MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient

Open in new window


Replace with this...

        If Dir(Attachment1) <> "" And Dir(Attachment2) <> "" And Dir(Attachment3) <> "" 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

Open in new window


This will populate in t column if the attachment is missing rather then sending email...

Saurabh...
Avatar of Seamus2626

ASKER

Thanks Saurabh

Somehow that has caused 4/5 of my names not to get attachment.

I must go through the logic of the IF AND
Yeah then in those 4 or 5 names which you got..you don't have the complete all the 3 attachments and thats why it's giving you that..

So against all those names if you compared with attachment names for all 3 you will see what i mean...
And if you want to see which attachment is missing then you can try the following code..It will tell you which attachment is missing...

If Dir(attachment1) <> "" And Dir(attachment2) <> "" And Dir(attachment3) <> "" Then
    MailDoc.PostedDate = Now()
    On Error GoTo errorhandler1
    MailDoc.SEND 0, Recipient
Else


    If Dir(attachment1) = "" Then Cells(cell.Row, "t").Value = "Attachments Missing --> " & attachment1
    If Dir(attachment2) = "" And Dir(attachment1) = "" Then
        Cells(cell.Row, "t").Value = "Attachments Missing --> " & attachment1 & " And " & Attacment2
    Else
        Cells(cell.Row, "t").Value = "Attachments Missing --> " & attachment2
    End If

    If Dir(attachment2) = "" And Dir(attachment1) = "" And Dir(attachment3) = "" Then
        Cells(cell.Row, "t").Value = "Attachments Missing --> " & attachment1 & " And " & Attacment2 & " And " & Attacment3
    ElseIf Dir(attachment1) = "" And Dir(attachment3) = "" Then
        Cells(cell.Row, "t").Value = "Attachments Missing --> " & attachment1 & " And " & Attacment3
    ElseIf Dir(attachment2) = "" And Dir(attachment3) = "" Then
        Cells(cell.Row, "t").Value = "Attachments Missing --> " & attachment2 & " And " & Attacment3
    Else
        Cells(cell.Row, "t").Value = "Attachments Missing --> " & attachment3

    End If

End If

Open in new window


Saurabh...
So should we change the And to an Or?

Or does an AND make more sense

Basically, i don't want the file sent if all three attachments are blank
So what i understand..Not necessairly you will have 3 attachments even if it has 1 attachments it should go.??

Saurabh...
Wouldn't it be easier to count the attachments while processing? Or just add a variable at the start with the name hasAttachments, set it to False, and whenever an attachment is added you set hasAttachments to True. Then at the end, you have
If hasAttachments Then MailDoc.Send...
Sorry lads, have been away from desk until now

Saurabh

So what i understand..Not necessairly you will have 3 attachments even if it has 1 attachments it should go.??

Yep, even if it only has one attachment it goes, if it has zero attachments we send the "no attachments" line to excel

Thanks!
ASKER CERTIFIED SOLUTION
Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Perfect Saurab, thanks!