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

Lotus notes email code

I have attached some code which finds files in folders based on names.

I have attached the file and code that im using.

I have 8 types of files that maybe found

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

So ideally I need the code to search for a name beginning with Smith, John and ending with booked .pdf or managed.pdf

Any amendments would be appreciated!

Thanks
Burst-Tool-EE.xlsm
0
Seamus2626
Asked:
Seamus2626
  • 8
  • 5
1 Solution
 
Steve KnightIT ConsultancyCommented:
Where do "CMB-LC" etc. come from.  I don't see those on your sheet, you mean you need to check for those filenames on the disc in a known path?  You can check for files using various methods including:

filename=dir$("D:\some path\Smith, John*managed.pdf")
do while filename<>""
   debug.print filename
   filename=dir$
loop

You can make the  path up to look for in the dir$ command using your existing strings built up from the sheet etc - I coulnd't work out quickly where "str" came from.

Steve
0
 
Seamus2626Author Commented:
CMB-LC can be found in the directory where the code is searching.

You can see the code in the sheet?
0
 
Steve KnightIT ConsultancyCommented:
Yes, I mean whether it was specified on the sheet at all.  In which case you can do a dir like above to get the files that match then attach those.  At the moment it appears you are doing:

   
 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") & ") - Booked .pdf"

Open in new window

Not sure where str is being set from where I was looking, maybe in a bit you haven't posted or just missed it.

I presume if you don't want the bits with date in etc. too (will there be more than one?) you want to search for:

str & " " & Cells(5, 14).Value & "*Booked .pdf"

Open in new window


so you could loop like above suggestion to get the filename.  Is there likely / possible to be more than one though?
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Steve KnightIT ConsultancyCommented:
i.e.

strfilename3=dir$(str & " " & Cells(5, 14).Value & "*Booked .pdf")

strFilename3 would be blank if there isn't a match.

but if there is possibility of more than one match file would have to handle looking through all of them and deciding.

Steve
0
 
Seamus2626Author Commented:
Hi Steve,

STR is picked up from Col K.

The asterisk does not work as a wild card, a wild card would be great.

That is, it searches the name in Col K, and then attaches any pdf's that are like that.

My attempt at capturing all possibilities is below.

Below you can see from my amended code that I am trying to search for all possibilities (listed in the code) but when I run the below sub it only attaches the first attachment (GB-CORP) but misses out (CMB-LC) & (MME)

Can you see why it cant find those options (they are in the folder)


Public rng As Range, cell As Range

Sub get_data_me()

    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_me cell.Value, cell.Offset(0, 1).Value

    Next cell
    
    MsgBox "Files sent"

End Sub

Sub send_email_me(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 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 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 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("http://teams.global.hsbc/cmb/PCM-Sales-Portal/PCM%20Docments/HORIS/Horis%20Dashboard%20User%20Guide.pdf")
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
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 & " " & "- GB-CORP" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed Region .pdf"
    stfilename2 = str & " " & "- GB-CORP" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    stfilename3 = str & " " & "- GB-CORP" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
    stfilename4 = str & " " & "- GB-FI" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed Region .pdf"
    stfilename5 = str & " " & "- GB-FI" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    stfilename6 = str & " " & "- GB-FI" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
    stfilename7 = str & " " & "- CMB-LC" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed Region .pdf"
    stfilename8 = str & " " & "- CMB-LC" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    stfilename9 = str & " " & "- CMB-LC" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .pdf"
    stfilename10 = str & " " & "- MME" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed Region .pdf"
    stfilename11 = str & " " & "- MME" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Managed .pdf"
    stfilename12 = str & " " & "- MME" & " (" & Format(Cells(5, 15).Value, "mmm-yy") & ") - Booked .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

If Attachment4 <> "" Then
On Error Resume Next
Set AttachME4 = MailDoc.CreateRichTextItem("attachment4")
Set EmbedObj4 = AttachME.EmbedObject(1454, "attachment4", Attachment4, "") 'Required File Name
On Error Resume Next
End If

If Attachment5 <> "" 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

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


If Attachment8 <> "" Then
On Error Resume Next
Set AttachME8 = MailDoc.CreateRichTextItem("attachment8")
Set EmbedObj8 = AttachME.EmbedObject(1454, "attachment8", Attachment8, "") 'Required File Name
On Error Resume Next
End If

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

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

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

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




   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) <> "" 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 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
.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 AttachME6 = Nothing
Set AttachME7 = Nothing
Set AttachME8 = Nothing
Set AttachME9 = Nothing
Set AttachME10 = Nothing
Set AttachME11 = Nothing
Set AttachME12 = 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


End Sub

Open in new window

0
 
Steve KnightIT ConsultancyCommented:
Well have a look when on PC later.  That is why i suggested for command as it will search the file system rather than try various options one at a time?
0
 
Steve KnightIT ConsultancyCommented:
Try something along these lines:



On Error Resume Next
MailDoc.SaveMessageOnSend = True
Set AttachME = MailDoc.CreateRichTextItem("attachments")

attach=0
strfilename=dir$(str & " " & Cells(5, 14).Value & "*Booked.pdf")
do while strfilename<>""
  attach=attach+1
  Set EmbedObj = AttachME.EmbedObject(1454, "attachments", stpath & "\" & strFileName, "") 'Required File Name
  strfilename=dir$
loop

strfilename=dir$(str & " " & Cells(5, 14).Value & "*Managed*.pdf")
do while strfilename<>""
  attach=attach+1
  Set EmbedObj = AttachME.EmbedObject(1454, "attachments", stpath & "\" & strFileName, "") 'Required File Name
  strfilename=dir$
loop

if attach=0 then 
  msgbox "Issue with attachments... etc.
end if

Open in new window

0
 
Seamus2626Author Commented:
Steve, im not the best with VBA, still beginning, are you able to put your code into my above sub, so I can test?

Thanks!
0
 
Steve KnightIT ConsultancyCommented:
Will do later. For now between first stfilename=   lline to after all those attach bits (remove all those).  Will join or up for you but 11 pm here.
0
 
Steve KnightIT ConsultancyCommented:
Had tried this earlier, give it a try, quite likely some errors haven't tried it in excel yet,

Steve

Sub send_email_me(str As String, str1 As String)
'


Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim Session As Object
Dim ccRecipient As String

Dim stSignature As String

On Error Resume Next


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("http://teams.global.hsbc/cmb/PCM-Sales-Portal/PCM%20Docments/HORIS/Horis%20Dashboard%20User%20Guide.pdf")
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 stfilename as string
Dim stpath As String

MailDoc.SaveMessageOnSend = True

attach=0
strfilename=dir$(str & " " & Cells(5, 14).Value & "*Booked.pdf")
do while strfilename<>""
  attach=attach+1
  call mailbody.EmbedObject(1454, "attachments", stpath & "\" & strFileName, "") 'Required File Name
  strfilename=dir$
loop

strfilename=dir$(str & " " & Cells(5, 14).Value & "*Managed*.pdf")
do while strfilename<>""
  attach=attach+1
  call mailbody.EmbedObject(1454, "attachments", stpath & "\" & strFileName, "") 'Required File Name
  strfilename=dir$
loop

if attach=0 then 
  msgbox "Issue with attachments... etc.
  Cells(cell.Row, "t").Value = "Email attachment is missing for this name"
else
  MailDoc.PostedDate = Now()
  On Error GoTo errorhandler1
  MailDoc.SEND 0, Recipient
end if
                                          
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With

end sub
                                          

Open in new window

0
 
Seamus2626Author Commented:
I will test today Steve, thanks!
0
 
Seamus2626Author Commented:
Perfect Steve, thank you very much!
0
 
Steve KnightIT ConsultancyCommented:
No problem.
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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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