VBA通过IBM Notes发送电子邮件不起作用？

Question

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

Answer 1

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:

• Change your 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.)
• Remove the multitude of extra blank lines. Some blanks are nice to help visually group code into logical chunks, but all the extras make it very difficult to read.
• Indent your code properly. It's very difficult to tell where the IF , With and For blocks end because most of them are left justified, but random bits are indented by random amounts.
  • If your 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.
• Check out Rubberduck - it will automatically do the indenting for you as well as bringing a lot of of other cool tricks & toys to the table. (Not an author, but a happy user and unintentional beta tester.)

Answer 2

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.