Lotus notes send email with attachments

Hi,

Attached is code that I have for sending emails with attachments from a shared drive to a list of recipients.

What I need is an amendment to the code

At present it looks in one location

stpath = "R:\ABC\Loris Info\Loris_Project\GBM\Nov-14\Output\CMB NA Data_With Macro"

I would like to query 5/6 locations e.g

stpath = "R:\ABC\Loris Info\Loris_Project\GBM\Nov-14\Output\CMB NA Data_With Macro"
stpath = "R:\ABC\Loris Info\Loris_Project\GBM\Nov-14\Output\CMB LA Data_With Macro"
stpath = "R:\ABC\Loris Info\Loris_Project\GBM\Nov-14\Output\CMB EU Data_With Macro"
stpath = "R:\ABC\Loris Info\Loris_Project\GBM\Nov-14\Output\CMB ASP Data_With Macro"
stpath = "R:\ABC\Loris Info\Loris_Project\GBM\Nov-14\Output\CMB ME Data_With Macro"

What amendments would I need?

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.SendTo = Recipient
MailDoc.Subject = "PUT YOUR SUBJECT HERE"
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:\ABC\Loris Info\Loris_Project\GBM\Nov-14\Output\CMB NA Data_With Macro"

    stfilename1 = str & " - Managed (Nov-14).pdf"
    stfilename2 = str & " - Booked (Nov-14).pdf"
    stfilename3 = str & ".xls"

    

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

Seamus2626Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:
Seamus,

In order to make this amendments..Can you create that in excel workbook as in how it will look like and i can write the macro to do that for you...

Saurabh...
0
Seamus2626Author Commented:
Cool, I have attached my current wb with the code that searches the folder All, you can see from my screenshot capture that underneath our the folders that make up all - my capture 1 is the next subset - the folders that need to be searched are

Booked
Managed
Managed Region

So if someone selects Europe  - GB Corp on the spreadsheet (dropdown boxes) the code must search

D:\ABC\Boris Info\Boris_Project\GBM\Jan-15\Output\Europe\GB-Corp\Booked
D:\ABC\Boris Info\Boris_Project\GBM\Jan-15\Output\Europe\GB-Corp\Managed
D:\ABC\Boris Info\Boris_Project\GBM\Jan-15\Output\Europe\GB-Corp\Managed Region

Then if they select GB-FI - it searches the same structure but instead of GB-Corp, GB-FI

Hope that makes sense Saurabh!
Capture-1.PNG
Capture.PNG
Burst-Tool-EE.xlsm
0
Saurabh Singh TeotiaCommented:
Quick question can you write the folder name in the path that you want to search or you want to hard code the same in the macro itself?
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Seamus2626Author Commented:
Ideally I would like the path to be hard coded to this point

R:\SPM\Horis Info\Boris_Project\GBM

then the rest of the destination determined by the cells O5, M5 and N5

ending up for example with

R:\SPM\Horis Info\Boris_Project\GBM\Jan-15\Output\Middle East\GB-Corp

So the month (Jan-15), region (Middle East) and business area (GB-Corp)  can change depending on the dropdowns in excel, but the rest of the destination eg. Boris project, output are fixed

Thanks!
0
Saurabh Singh TeotiaCommented:
Their you go i did necessary changes in the code to read the rest of the file path one by one from O5 to N5 and then on this path check for the file and if the file is found attach it..

Just make sure your path of O5 to N5 is correct in order for to work correctly...

Option Explicit

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

Dim r1 As Range, c1 As Range

Set r1 = Range("O5:N5")


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.SendTo = Recipient
MailDoc.Subject = "PUT YOUR SUBJECT HERE"
MailDoc.Body = _
"Attached"
' Select Workbook to Attach to E-Mail

Dim stfilename1 As String, stfilename2 As String, stfilename3 As String
Dim stpath As String

For Each c1 In r1

stpath = "R:\ABC\Loris Info\Loris_Project\GBM\" & c1.Value

    stfilename1 = str & " - Managed (Nov-14).pdf"
    stfilename2 = str & " - Booked (Nov-14).pdf"
    stfilename3 = str & ".xls"

    

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

Next c1

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


Saurabh...
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Seamus2626Author Commented:
Il test in the morning, thanks Saurabh!
0
Seamus2626Author Commented:
Thanks Saurabh!!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Lotus IBM

From novice to tech pro — start learning today.