Bounced messages (POP3 part)
From: MAILER-DAEMON@afterlogic.com To: MailBee@afterlogic.com Subject: Undeliverable mail: A word from MailBee Support Team Failed to deliver to 'abc@you.com' SMTP module(domain you.com) reports: you.com: no DNS A-data returned |
Dim objPOP3, objMsgs, strEmail, I ' Create POP3 object Set objPOP3 = CreateObject("MailBee.POP3") ' Enable logging POP3 session into a file objPOP3.EnableLogging = True objPOP3.LogFilePath = "C:\Temp\pop3_log.txt" ' Unlock POP3 object objPOP3.LicenseKey = "put your license key here" ' Set POP3 server name objPOP3.ServerName = "mail.server.com" ' Set user credentials objPOP3.UserName = "username" objPOP3.Password = "password" ' Connect to the server and log in the mailbox If objPOP3.Connect Then ' Get headers + 100 body lines for all messages. ' 100 body lines is enough because failed address ' is somewhere in the beginning of the body Set objMsgs = objPOP3.RetrieveHeaders(1, -1, 100)
If Not objPOP3.IsError Then ' Loop through all messages in the mailbox For I = 1 To objMsgs.Count ' Get failed email address strEmail = GetInvalidEmailAddress(objMsgs(I)) ' If strEmail is non-empty, failed email address ' was found If Len(strEmail) > 0 Then ' Remove failed email from database RemoveEmailFromDatabase strEmail ' Delete bounced email from server to avoid ' processing it next time objPOP3.DeleteMessage I
End If Next Else ' Display error information MsgBox "Error #" & objPOP3.ErrCode & ", " & objPOP3.ErrDesc End If ' Close the connection objPOP3.Disconnect Else ' Display error information MsgBox "Error #" & objPOP3.ErrCode MsgBox "Server response: " & objPOP3.ServerResponse End If ' The functions checks whether the message ' is bounced and extracts failed address ' from bounced message Function GetInvalidEmailAddress(objMsg) Dim I1, I2 GetInvalidEmailAddress = "" ' Check if this is a bounced message report If InStr(1, objMsg.FromAddr, "Mailer-Daemon", 1) < 1 Then Exit Function If InStr(1, objMsg.Subject, "Undeliverable mail", 1) <> 1 Then Exit Function ' Now we're sure this is a bounced message report I1 = InStr(1, objMsg.BodyText, "'", 0) I2 = InStr(I1 + 1, objMsg.BodyText, "'", 0) ' Message does not contain email address? If I1 < 1 Or I2 < 1 Then Exit Function ' Get failed address GetInvalidEmailAddress = Mid(objMsg.BodyText, I1 + 1, I2 - I1 - 1) ' E-mail address is often enclosed in "<>". ' Remove them if needed. If Left(GetInvalidEmailAddress, 1) = "<" And Right(GetInvalidEmailAddress, 1) = ">" Then GetInvalidEmailAddress = Mid(GetInvalidEmailAddress, 2, Len(GetInvalidEmailAddress) - 2) End If End Function ' This function must remove (or disable) specified ' email address from mailing list Sub RemoveEmailFromDatabase(strEmail) ' Do nothing for this demo End Sub
<% Dim objPOP3, objMsgs, strEmail, I ' Create POP3 object Set objPOP3 = Server.CreateObject("MailBee.POP3") ' Enable logging POP3 session into a file objPOP3.EnableLogging = True objPOP3.LogFilePath = "C:\Temp\pop3_log.txt" ' Unlock POP3 object objPOP3.LicenseKey = "put your license key here" ' Set POP3 server name objPOP3.ServerName = "mail.server.com" ' Set user credentials objPOP3.UserName = "username" objPOP3.Password = "password" ' Connect to the server and log in the mailbox If objPOP3.Connect Then ' Get headers + 100 body lines for all messages. ' 100 body lines is enough because failed address ' is somewhere in the beginning of the body Set objMsgs = objPOP3.RetrieveHeaders(1, -1, 100)See Also:
If Not objPOP3.IsError Then ' Loop through all messages in the mailbox For I = 1 To objMsgs.Count ' Get failed email address strEmail = GetInvalidEmailAddress(objMsgs(I)) ' If strEmail is non-empty, failed email address ' was found If Len(strEmail) > 0 Then ' Remove failed email from database RemoveEmailFromDatabase strEmail ' Delete bounced email from server to avoid ' processing it next time objPOP3.DeleteMessage I
End If Next Else ' Display error information Response.Write "Error #" & objPOP3.ErrCode & ", " & objPOP3.ErrDesc End If ' Close the connection objPOP3.Disconnect Else ' Display error information Response.Write "Error #" & objPOP3.ErrCode & "<br>" Response.Write "Server response: " & objPOP3.ServerResponse End If ' The functions checks whether the message ' is bounced and extracts failed address ' from bounced message Function GetInvalidEmailAddress(objMsg) Dim I1, I2 GetInvalidEmailAddress = "" ' Check if this is a bounced message report If InStr(1, objMsg.FromAddr, "Mailer-Daemon", 1) < 1 Then Exit Function If InStr(1, objMsg.Subject, "Undeliverable mail", 1) <> 1 Then Exit Function ' Now we're sure this is a bounced message report I1 = InStr(1, objMsg.BodyText, "'", 0) I2 = InStr(I1 + 1, objMsg.BodyText, "'", 0) ' Message does not contain email address? If I1 < 1 Or I2 < 1 Then Exit Function ' Get failed address GetInvalidEmailAddress = Mid(objMsg.BodyText, I1 + 1, I2 - I1 - 1) ' E-mail address is often enclosed in "<>". ' Remove them if needed. If Left(GetInvalidEmailAddress, 1) = "<" And Right(GetInvalidEmailAddress, 1) = ">" Then GetInvalidEmailAddress = Mid(GetInvalidEmailAddress, 2, Len(GetInvalidEmailAddress) - 2) End If End Function ' This function must remove (or disable) specified ' email address from mailing list Sub RemoveEmailFromDatabase(strEmail) ' Do nothing for this demo End Sub %>