公司的邮件系统用的是反人类的 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
View Code VBA但是现实情况是这样的
我们需要邮件从公邮发送出去
何谓公邮:整个Team使用的邮箱,如***[email protected] 之类的邮箱
使用过反人类的 Lotus notes 都知道公邮是需要先打开小我私家邮箱才华进去的
于是当我把以上的VBA 代码增加如下代码,设置从公邮里面发送邮件后