前言
公司的邮件系统用的是反人类的 Lotus notes, 你敢信？
最近要实现一个功能，邮件提醒功能，就是通过自动发送提醒邮件
前前后后这个问题搞了2天，由于公司的诸多条件限制，无法直接调用到公司发送邮件的接口，只有通过类似 Lotus script，VBA 等其他方式来实现。
用VBA代码实现发送邮件，其实我在n年前就实现过了
代码如下，网上一搜也一大堆
Function SendEmailbyNotesWithAttachement_2(Addresses, Attach, cc)
strSubject = ThisWorkbook.Sheets("EMAIL").Range("B1")
strbody = ThisWorkbook.Sheets("EMAIL").Range("A1")
'Declare Variables
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 message As Object
' Notes variables
Set s = CreateObject("Notes.NotesSession")
Set db = s.CURRENTDATABASE
Set stream = s.CreateStream
' Turn off auto conversion to rtf
s.ConvertMIME = False
' Create message
Set message = db.CREATEDOCUMENT
message.Form = "memo"
message.Subject = strSubject
message.sendTo = Split(Addresses, ";")
message.CopyTo = cc
message.SaveMessageOnSend = True
' Create the body to hold HTML and attachment
Set body = message.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=UTF-8", ENC_NONE)
Call stream.Close
Call stream.Truncate
' This will run though an array of attachment paths and add them to the email
For i = 0 To UBound(Attach)
strAttach = Attach(i)
If Len(strAttach) > 0 And Len(Dir(strAttach)) > 0 Then
' Get the attachment file name
pos = InStrRev(strAttach, "")
Filename = Right(strAttach, Len(strAttach) - pos)
'A new child mime entity to hold a file attachment
Set bodyChild = body.CreateChildEntity()
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 = s.CreateStream()
If Not stream.Open(strAttach, "binary") Then
MsgBox "Open failed"
End If
If stream.Bytes = 0 Then
MsgBox "File has no content"
End If
Call bodyChild.SetContentFromBytes(stream, "application/octet-stream", ENC_IDENTITY_BINARY) ' All my attachments are excel this would need changing depensding on your attachments.
End If
Next
'Send the email
Call message.Send(False)
s.ConvertMIME = True ' Restore conversion
End Function
VBA
