• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 190
  • Last Modified:

Lotus notes email code

Hi,

I have some code that finds pdf's and excel files.

Currently the code will find

Smith, John (Feb-15) - Managed .pdf  
Smith, John (Feb-15) - Booked .pdf  

etc etc

My file names now have an extra component and they will be either

Smith, John - GB-CORP (Feb-15) - Managed .pdf  or
Smith, John - GB-FI (Feb-15) - Managed .pdf  or
Smith, John - CMB-LC (Feb-15) - Managed .pdf  or
Smith, John - CMB-MME (Feb-15) - Managed .pdf  or

How can I factor in these new additions to the file name into the below code?

Thanks!

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 = Range("R5").Value
MailDoc.SendTo = Recipient
MailDoc.Subject = "Sales Manager Horis Report Feb 2015"

Set mailbody = MailDoc.CreateRichTextItem("Body")
Call mailbody.AppendText("Please find attached your Sales Manager Horis Reports for February 2015. ")
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
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 & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    stfilename2 = str & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
    stfilename3 = str & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region .pdf"
    stfilename4 = str & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed.xlsx"
    stfilename5 = str & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked.xls"
    stfilename6 = str & " (" & 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









   If Dir(Attachment1) <> "" Or Dir(Attachment2) <> "" Or Dir(Attachment3) <> "" Or Dir(Attachment4) <> "" Or Dir(Attachment5) <> "" Or Dir(Attachment6) <> "" 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 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

0
Seamus2626
Asked:
Seamus2626
1 Solution
 
Rgonzo1971Commented:
HI,

pls try

For Each stItem In Array("GB-CORP", "GB-FI", "CMB-LC", "CMB - MME")
    stFilenameTmp = str & " - " & stItem & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    If Len(Dir(stpath & "\" & stFilenameTmp)) > 0 Then
        stComp = stItem
        Exit For
    End If
Next
    stfilename1 = str & " - " & stComp & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    stfilename2 = str & " - " & stComp & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
    stfilename3 = str & " - " & stComp & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region .pdf"
    stfilename4 = str & " - " & stComp & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed.xlsx"
    stfilename5 = str & " - " & stComp & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked.xls"
    stfilename6 = str & " - " & stComp & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked Region.xlsx"
  

Open in new window

Regards
0
 
Seamus2626Author Commented:
Legend!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now