(Visual Basic 6.0) POP3 to SMTP Forwarder

Read a POP3 mailbox and forwards the email to another email address, keeping the recipients in the original email the same.

Chilkat ActiveX Downloads ActiveX for 32-bit and 64-bit Windows

' This example requires the Chilkat API to have been previously unlocked.
' See Global Unlock Sample for sample code.

Dim mailman As New ChilkatMailMan

Dim success As Long

' Set the POP3 server's hostname
mailman.MailHost = "pop.example.com"

' Set the POP3 login/password.
mailman.PopUsername = "MY_LOGIN"
mailman.PopPassword = "MY_PASSWORD"

Dim saUidls As CkStringArray

' The the UIDLs for all email in the POP3 mailbox.
Set saUidls = mailman.GetUidls()
If (mailman.LastMethodSuccess = 0) Then
    Debug.Print mailman.LastErrorText
    Exit Sub
End If

Dim saMime As CkStringArray

' Download the email from the server.  Call FetchMultipleMime
' because we don't want to load the emails into email objects.
' (We'll delete the emails that are forwarded without error.)
' Note: It is not reasonable to call this method for a mailbox containing
' a huge number of emails.  For large mailboxes, it's better to download
' one by one and process each email independently. This way, if a 
' server or communications error occurs, it's possible to write code
' that can resume.
Set saMime = mailman.FetchMultipleMime(saUidls)

If (mailman.LastMethodSuccess = 0) Then

    Debug.Print mailman.LastErrorText
    Exit Sub
End If

' Set the SMTP hostname for sending.
mailman.SmtpHost = "smtp.example.com"
mailman.SmtpUsername = "MY_SMTP_LOGIN"
mailman.SmtpPassword = "MY_SMTP_PASSWORD"

Dim n As Long
n = saMime.Count

Dim fromAddr As String
fromAddr = "me@example.com"
Dim toAddr As String
toAddr = "recipient@somewhere.com"

Dim bAllOk As Long
bAllOk = 1

Dim i As Long
i = 0
Do While i < n

    Dim strMime As String
    strMime = saMime.GetString(i)

    ' Forward the email.
    success = mailman.SendMime(fromAddr,toAddr,strMime)
    If (success <> 1) Then
        bAllOk = 0
        Debug.Print mailman.LastErrorText
        ' Force loop exit.
        i = n
    End If

    i = i + 1
Loop

' Remove the emails in saUidls from the POP3 server.
If (bAllOk = 1) Then
    success = mailman.DeleteMultiple(saUidls)
    If (success <> 1) Then
        Debug.Print mailman.LastErrorText
    End If

End If

Debug.Print "bAllOk = " & bAllOk