I am using the following vba code to try and send an email from IBM Notes with an attachment.
Here is my code:
Sub Send_Email()
Dim answer As Integer
answer = MsgBox("Are you sure you want to Send All Announcements?", vbYesNo + vbQuestion, "Notice")
If answer = vbNo Then
Exit Sub
Else
'Define Parameters for Email
Dim s As Object
Dim db As Object
Dim body As Object
Dim bodyChild As Object
Dim header As Object
Dim stream As Object
Dim host As String
Dim MailDoc As Object
'Define Sheet Parameters
Dim i As Long
Dim j As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row 'Finds the last used row
j = 18
'Start a session of Lotus Notes
Set Session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Set db = Session.CurrentDatabase
Set stream = Session.CreateStream
' Turn off auto conversion to rtf
Session.ConvertMime = False
With ThisWorkbook.Worksheets(1)
For i = 18 To LastRow
' Create message
Set MailDoc = db.CreateDocument
MailDoc.Form = "Memo"
'Set From
MailDoc.SendTo = Range("Q" & i).value
MailDoc.SentBy = "Food.Specials@Lidl.co.uk"
MailDoc.tmpDisplaySentBy = "Food.Specials@Lidl.co.uk"
MailDoc.FROM = "Food.Specials@Lidl.co.uk"
MailDoc.SendFrom = "Food.Specials@Lidl.co.uk"
MailDoc.Principal = "Food Specials <mailto:Food.Specials@Lidl.co.uk>"
MailDoc.Subject = "Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required"
'MailDoc.SendTo = Range("Q" & i).value
'Call MailDoc.ReplaceItemValue("CopyTo", "food.specials@lidl.co.uk")
MailDoc.SaveMessageOnSend = True
' Create the body to hold HTML and attachment
Set body = MailDoc.CreateMIMEEntity
'Child mime entity which is going to contain the HTML which we put in the stream
Set bodyChild = body.CreateChildEntity()
Call stream.WriteText(strbody)
Call bodyChild.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_NONE)
Call stream.Close
Call stream.Truncate
' Get the attachment file name
filename = Range("F" & i).value
'A new child mime entity to hold a file attachment
Set header = bodyChild.CreateHeader("Content-Type")
Call header.SetHeaderVal("multipart/mixed")
Set header = bodyChild.CreateHeader("Content-Disposition")
Call header.SetHeaderVal("attachment; filename=" & filename)
Set header = bodyChild.CreateHeader("Content-ID")
Call header.SetHeaderVal(filename)
Set stream = Session.CreateStream()
Call bodyChild.SetContentFromBytes(stream, "application/msexcel", ENC_IDENTITY_BINARY) ' All my attachments are excel this would need changing depensding on your attachments.
'Call bodyChild.SetContentFromBytes(1454, "", Range("F" & i).value, "Attachment")
'Send the email
Call MailDoc.Send(False)
Session.ConvertMime = True ' Restore conversion
j = j + 1
Next i
End With
'Clean Up the Object variables - Recover memory
Application.CutCopyMode = False
MsgBox "Success!" & vbNewLine & "Announcements have been sent."
End If
End Sub
It doesn't seem to want to attach any attachment or send. I get an error: Object Variable or with block variable not set on this line:
Call header.SetHeaderVal("multipart/mixed")
Please can someone show me where i am going wrong?
EDIT 2:
Ok i managed to get rid of the errors and get the email to send.
However, it's not sending the attachment properly. All i see is something like this:
Here is the code:
Sub Send_Email()
Dim answer As Integer
answer = MsgBox("Are you sure you want to Send All Announcements?", vbYesNo + vbQuestion, "Notice")
If answer = vbNo Then
Exit Sub
Else
'Define Parameters for Email
Dim s As Object
Dim db As Object
Dim body As Object
Dim bodyChild As Object
Dim header As Object
Dim stream As Object
Dim host As String
Dim MailDoc As Object
'Define Sheet Parameters
Dim i As Long
Dim j As Long
Dim server, mailfile, user, usersig As String
Dim LastRow As Long, ws As Worksheet
LastRow = Worksheets(1).Range("F" & Rows.Count).End(xlUp).Row 'Finds the last used row
j = 18
'Start a session of Lotus Notes
Set Session = CreateObject("Notes.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Set db = Session.CurrentDatabase
Set stream = Session.CreateStream
' Turn off auto conversion to rtf
Session.ConvertMime = False
With ThisWorkbook.Worksheets(1)
For i = 18 To LastRow
' Create message
Set MailDoc = db.CreateDocument
MailDoc.Form = "Memo"
'Set From
MailDoc.SendTo = Range("Q" & i).value
MailDoc.SentBy = "Food.Specials@Lidl.co.uk"
MailDoc.tmpDisplaySentBy = "Food.Specials@Lidl.co.uk"
MailDoc.FROM = "Food.Specials@Lidl.co.uk"
MailDoc.SendFrom = "Food.Specials@Lidl.co.uk"
MailDoc.Principal = "Food Specials <mailto:Food.Specials@Lidl.co.uk>"
MailDoc.Subject = "Promotion Announcement for week " & Range("I8").value & ", " & Range("T8").value & " - Confirmation required"
'MailDoc.SendTo = Range("Q" & i).value
'Call MailDoc.ReplaceItemValue("CopyTo", "food.specials@lidl.co.uk")
MailDoc.SaveMessageOnSend = True
' Create the body to hold HTML and attachment
Set body = MailDoc.CreateMIMEEntity
'Child mime entity which is going to contain the HTML which we put in the stream
Set bodyChild = body.CreateChildEntity()
Call stream.WriteText(strbody)
Call bodyChild.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_NONE)
Call stream.Close
Call stream.Truncate
filename = Range("F" & i).value
'A new child mime entity to hold a file attachment
Set bodyChild = body.CreateChildEntity()
Set header = bodyChild.CreateHeader("Content-Type")
header.SetHeaderVal ("multipart/mixed")
Set header = bodyChild.CreateHeader("Content-Disposition")
header.SetHeaderVal ("attachment; filename=" & filename)
Set header = bodyChild.CreateHeader("Content-ID")
header.SetHeaderVal (filename)
Set stream = Session.CreateStream()
Call bodyChild.SetContentFromBytes(stream, "application/msexcel", ENC_IDENTITY_BINARY) ' All my attachments are excel this would need changing depensding on your attachments.
'Send the email
Call MailDoc.Send(False)
Session.ConvertMime = True ' Restore conversion
j = j + 1
Next i
End With
'Clean Up the Object variables - Recover memory
Application.CutCopyMode = False
MsgBox "Success!" & vbNewLine & "Announcements have been sent."
End If
End Sub
Please can someone show me why my excel file is not attaching correctly? Thanks
You're trying to Call
a method of an Object
, there's no need to do that.
Call
is an obsolete way of invoking a Sub
. It is no longer necessary and often ends up causing subtle run-time errors, and should be avoided.
changing
Call header.SetHeaderVal("multipart/mixed")
to
header.SetHeaderVal = "multipart/mixed"
should do the trick. If that works and you get your RTE on the next line, repeat that process for all those unnecessary uses of Call
.
Also, I don't know Notes (used it years ago, never programmed for it), but this code
Set header = bodyChild.CreateHeader("Content-Type")
Call header.SetHeaderVal("multipart/mixed")
Set header = bodyChild.CreateHeader("Content-Disposition")
Call header.SetHeaderVal("attachment; filename=" & filename)
Set header = bodyChild.CreateHeader("Content-ID")
where you're constantly setting the same variable header
to a new item looks very suspicious. I'm not exactly sure how you'd go about setting those, but it just doesn't look right.
Other suggestions:
Dim
statements from using generic Object
to the specific Notes.<something>
object type. (Unless Notes wants a generic object for those - I've not used Notes in ages and didn't program for it when I did.) IF
, With
and For
blocks end because most of them are left justified, but random bits are indented by random amounts.
If
and End If
statements line up in the same column while everything that's contained in them is indented (2 or 4 columns), it's easy to see what's included in that If
statement. It looks to me like you've got the order and structure of your MIME headers wrong. You're generating a text\\html part first, then a multipart\\mixed and then you're setting the content of the multipart\\mixed as application\\msexcel.
A multipart\\mixed part should be a container. It has no content of its own. It contains two or more child parts.
You should probably be creating a multipart\\mixed MIMEEntity at the top level (child of body) and then creating two second-level child MIMEEntities that are children of the multipart\\mixed MIMEEntity: one child with content-type text\\html, and the second with content-type application\\msexcel.
The best strategy is usually to manually send a message that looks the way you want it to appear, then look at the MIME source for it and duplicate it's tree structure and order in your code.
Also,application\\msexcel content-type is for old-style .xls files. You may want to look at this article for the more up-to-date versions.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.