使用CQ API使用Email Rule发送邮件注意

通过API去改变CQ的状态或者内容的时候，触发Email-Rule需要注意。调用这个API或者说外部程序的用户必须设置email选项，否则将无法发出邮件。一定要注意，Email的设置在客户端“视图——电子邮件选项”内进行设置。

 

若不使用Email Rule去触发邮件，可在程序中加入Email代码，通过winsock发送邮件。

 

Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single

 

Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
         
   
If Winsock1.State = sckClosed Then ' Check to see if socet is closed
    Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail pre program start
    DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " +0800"
    first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Get who's sending E-Mail address
    Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' Get who mail is going to
    Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
    Fourth = "From:" + Chr(32) + FromName + vbCrLf ' Who's Sending
    Fifth = "To:" + Chr(32) + ToName + vbCrLf ' Who it going to
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
    Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
    Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
    Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combine for proper SMTP sending

    Winsock1.Protocol = sckTCPProtocol ' Set protocol for sending
    Winsock1.RemoteHost = MailServerName ' Set the server address
    Winsock1.RemotePort = 25 ' Set the SMTP Port
    Winsock1.Connect ' Start connection
   
    If WaitFor("220") = False Then GoTo closeSock
   
    StatusTxt.Caption = "Connecting...."
    StatusTxt.Refresh
   
    Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)

    If WaitFor("250") = False Then GoTo closeSock

    StatusTxt.Caption = "Connected"
    StatusTxt.Refresh

    Winsock1.SendData (first)

    StatusTxt.Caption = "Sending Message"
    StatusTxt.Refresh

    If WaitFor("250") = False Then GoTo closeSock

    Winsock1.SendData (Second)

    If WaitFor("250") = False Then GoTo closeSock

    Winsock1.SendData ("data" + vbCrLf)
   
    If WaitFor("354") = False Then GoTo closeSock

    Winsock1.SendData (Eighth + vbCrLf)
    Winsock1.SendData (Seventh + vbCrLf)
    Winsock1.SendData ("." + vbCrLf)

    If WaitFor("250") = False Then GoTo closeSock

    Winsock1.SendData ("quit" + vbCrLf)
   
    StatusTxt.Caption = "Disconnecting"
    StatusTxt.Refresh

    If WaitFor("221") = False Then GoTo closeSock

closeSock: Winsock1.Close
Else
    MsgBox (Str(Winsock1.State))
End If
  
End Sub
Function WaitFor(ResponseCode As String) As Boolean
    Start = Timer ' Time event so won't get stuck in loop
    While Len(Response) = 0
        Tmr = Timer - Start
        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
        If Tmr > 50 Then ' Time in seconds to wait
            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
            WaitFor = False
            Exit Function
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
            WaitFor = False
            Exit Function
        End If
    Wend
Response = "" ' Sent response code to blank **IMPORTANT**
WaitFor = True
End Function