Reputation: 415
I have an Excel sheet that I use as a mailing automatism for reports. As it currently is it attaches an actual copy of the excel workbook to the email and send them out. The mailer contains several different people, and they get different report each day. Due to the size of some of the files, I am starting to run into an issue where I cannot sent the emails anymore because they are too big, so I am wanting to switch to sending links to the files instead, and I have hit a wall.
I use Lotus Notes 8.5. The VBA will cycle through a range, and each cell has a list of report delimited by a ",". It takes the list and passes it to the mailer as a string. The mailer takes the string, turns it into an array and splits it out, and then checks to make sure the reports are current. One email could have up to 10 different reports in it. I have tried creating an HTML MIME email to include the links. Here is the code I currently have:
Sub Send_HTML_Email(ByRef Name As String, ByRef Address As String, ByRef Reports As String)
Const ENC_IDENTITY_8BIT = 1729
'Send Lotus Notes email containing links to files on local computer
Dim NSession As Object 'NotesSession
Dim NDatabase As Object 'NotesDatabase
Dim NStream As Object 'NotesStream
Dim NDoc As Object 'NotesDocument
Dim NMIMEBody As Object 'NotesMIMEEntity
Dim SendTo As String
Dim subject As String
Dim HTML As String, HTMLbody As String
Dim Array1() As String
Dim Links As String
Dim gRange As Variant
Dim i As Integer
SendTo = "[email protected]"
subject = "My Subject " & Name & "."
Debug.Print subject
Set NSession = CreateObject("Notes.NotesSession") 'using Lotus Notes Automation Classes (OLE)
Set NDatabase = NSession.GetDatabase("", "")
If Not NDatabase.IsOpen Then NDatabase.OPENMAIL
Set NStream = NSession.CreateStream
Array1 = Split(Reports, ",")
i = 1
HTML = "<html>" & vbLf & _
"<head>" & vbLf & _
"<meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbLf & _
"</head>" & vbLf & _
"<body>" & vbLf & _
"<p>" & gRange.Value & "</p>"
For Each gRange In Array1
Select Case gRange
Case "Report name 1"
Reports = "G:\file Location\Report Name 1.xlsx"
Case "Report name 2"
Reports = "G:\file Location\Report Name 2.xlsx"
Case "Report name 3"
Reports = "G:\file Location\Report Name 3.xlsx"
Case "Report name 4"
Reports = "G:\file Location\Report Name 4.xlsx"
Case "Report name 5"
Reports = "G:\file Location\Report Name 5.xlsx"
Case "Report name 6"
Reports = "G:\file Location\Report Name 6.xlsx"
End Select
If Reports <> "" And Format(FileDateTime(Reports), "mm/dd/yyyy") = Format(Now, "mm/dd/yyyy") Then
Select Case gRange
Case "Report name 1"
Links = "G:\file%20Location\Report%20Name%201.xlsx"
Case "Report name 2"
Links = "G:\file%20Location\Report%20Name%202.xlsx"
Case "Report name 3"
Links = "G:\file%20Location\Report%20Name%203.xlsx"
Case "Report name 4"
Links = "G:\file%20Location\Report%20Name%204.xlsx"
Case "Report name 5"
Links = "G:\file%20Location\Report%20Name%205.xlsx"
End Select
If Links <> "" Then
HTMLbodyi = ""<a href='file://" & Links & "'>" & gRange & "</a><br>""
End If
"</body>" & vbLf & _
"</html>"
i = i + 1
End If
Next gRange
NSession.ConvertMime = False 'Don't convert MIME to rich text
Set NDoc = NDatabase.CreateDocument()
With NDoc
.Form = "Memo"
.subject = subject
.SendTo = Split(SendTo, ",")
Set NMIMEBody = .CreateMIMEEntity
NStream.WriteText HTML
NMIMEBody.SetContentFromText NStream, "text/html; charset=UTF-8", ENC_IDENTITY_8BIT
.Send False
.Save True, False, False
End With
NSession.ConvertMime = True 'Restore conversion
Set NDoc = Nothing
Set NSession = Nothing
End Sub
I'm using the Case statement to switch the Report and Links set based on the array from the cell with the different report names in it. One persons cell may only have Report name 1
and Report name 3
, while the next person has all of them.
I really appreciate any help I can get!
The emails will send, but they are either blank, or they get to the first HTMLbodyi
and only include the initial <a
where the link should go and then the rest is blank.
Upvotes: 0
Views: 1254
Reputation: 22266
I see a problem with this line:
HTMLbodyi = "<a href='file://" & Links & "></><br>"
The HTML is malformed. It needs to be changed to this:
HTMLbodyi = "<a href='file://" & Links & "'>" & gRange & "</a><br>"
The other problem is that you are setting the HTML line on every iteration of the loop, but what you really want to do is just append the link within the loop. You'll need to break up this code:
HTML = "<html>" & vbLf & _
"<head>" & vbLf & _
"<meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbLf & _
"</head>" & vbLf & _
"<body>" & vbLf & _
"<p>" & gRange.Value & "</p>" & _
HTMLbodyi & _
"</body>" & vbLf & _
"</html>"
Set your HTML string to the portion up to the tag before the loop. Then in the loop, append the links. Then finally after the loop, add the </body></html>
to the HTML string.
Edit: Here's the updated code. Follow the HTML variable to see the key changes.
Sub Send_HTML_Email(ByRef Name As String, ByRef Address As String, ByRef Reports As String)
Const ENC_IDENTITY_8BIT = 1729
'Send Lotus Notes email containing links to files on local computer
Dim NSession As Object 'NotesSession
Dim NDatabase As Object 'NotesDatabase
Dim NStream As Object 'NotesStream
Dim NDoc As Object 'NotesDocument
Dim NMIMEBody As Object 'NotesMIMEEntity
Dim SendTo As String
Dim subject As String
Dim HTML As String, HTMLbody As String
Dim Array1() As String
Dim Links As String
Dim gRange As Variant
Dim i As Integer
SendTo = "[email protected]"
subject = "My Subject " & Name & "."
Debug.Print subject
Set NSession = CreateObject("Notes.NotesSession") 'using Lotus Notes Automation Classes (OLE)
Set NDatabase = NSession.GetDatabase("", "")
If Not NDatabase.IsOpen Then NDatabase.OPENMAIL
Set NStream = NSession.CreateStream
Array1 = Split(Reports, ",")
i = 1
HTML = "<html>" & vbLf & _
"<head>" & vbLf & _
"<meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbLf & _
"</head>" & vbLf & _
"<body>" & vbLf
For Each gRange In Array1
Select Case gRange
Case "Report name 1"
Reports = "G:\file Location\Report Name 1.xlsx"
Case "Report name 2"
Reports = "G:\file Location\Report Name 2.xlsx"
Case "Report name 3"
Reports = "G:\file Location\Report Name 3.xlsx"
Case "Report name 4"
Reports = "G:\file Location\Report Name 4.xlsx"
Case "Report name 5"
Reports = "G:\file Location\Report Name 5.xlsx"
Case "Report name 6"
Reports = "G:\file Location\Report Name 6.xlsx"
End Select
If Reports <> "" And Format(FileDateTime(Reports), "mm/dd/yyyy") = Format(Now, "mm/dd/yyyy") Then
Select Case gRange
Case "Report name 1"
Links = "G:\file%20Location\Report%20Name%201.xlsx"
Case "Report name 2"
Links = "G:\file%20Location\Report%20Name%202.xlsx"
Case "Report name 3"
Links = "G:\file%20Location\Report%20Name%203.xlsx"
Case "Report name 4"
Links = "G:\file%20Location\Report%20Name%204.xlsx"
Case "Report name 5"
Links = "G:\file%20Location\Report%20Name%205.xlsx"
End Select
If Links <> "" Then
HTML = HTML & ""<p><a href='file://" & Links & "'>" & gRange & "</a></p>""
End If
i = i + 1
End If
Next gRange
HTML = HTML & "</body>" & vbLf & "</html>"
NSession.ConvertMime = False 'Don't convert MIME to rich text
Set NDoc = NDatabase.CreateDocument()
With NDoc
.Form = "Memo"
.subject = subject
.SendTo = Split(SendTo, ",")
Set NMIMEBody = .CreateMIMEEntity
NStream.WriteText HTML
NMIMEBody.SetContentFromText NStream, "text/html; charset=UTF-8", ENC_IDENTITY_8BIT
.Send False
.Save True, False, False
End With
NSession.ConvertMime = True 'Restore conversion
Set NDoc = Nothing
Set NSession = Nothing
End Sub
Upvotes: 3