Xojo Plugin

Copy Email from one IMAP Account to Another

See more IMAP Examples

Demonstrates how to copy the email in a mailbox from one account to another. Xojo Plugin

Dim success As Boolean
success = False

Dim imapSrc As New Chilkat.Imap

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

// Connect to our source IMAP server.
imapSrc.Ssl = True
imapSrc.Port = 993
success = imapSrc.Connect("MY-IMAP-DOMAIN")
If (success <> True) Then
    System.DebugLog(imapSrc.LastErrorText)
    Return
End If

// Login to the source IMAP server
success = imapSrc.Login("MY-IMAP-LOGIN","MY-IMAP-PASSWORD")
If (success <> True) Then
    System.DebugLog(imapSrc.LastErrorText)
    Return
End If

Dim imapDest As New Chilkat.Imap

// Connect to our destination IMAP server.
imapDest.Ssl = True
imapDest.Port = 993
success = imapDest.Connect("MY-IMAP-DOMAIN2")
If (success <> True) Then
    System.DebugLog(imapDest.LastErrorText)
    Return
End If

// Login to the destination IMAP server
success = imapDest.Login("MY-IMAP-LOGIN2","MY-IMAP-PASSWORD2")
If (success <> True) Then
    System.DebugLog(imapDest.LastErrorText)
    Return
End If

// Select a source IMAP mailbox on the source IMAP server
success = imapSrc.SelectMailbox("Inbox")
If (success <> True) Then
    System.DebugLog(imapSrc.LastErrorText)
    Return
End If

Dim fetchUids As Boolean
fetchUids = True

// Get the set of UIDs for all emails on the source server.
Dim mset As Chilkat.MessageSet
mset = imapSrc.Search("ALL",fetchUids)
If (imapSrc.LastMethodSuccess <> True) Then
    System.DebugLog(imapSrc.LastErrorText)
    Return
End If

// Load the complete set of UIDs that were previously copied.
// We dont' want to copy any of these to the destination.
Dim fac As New Chilkat.FileAccess
Dim msetAlreadyCopied As New Chilkat.MessageSet
Dim strMsgSet As String
strMsgSet = fac.ReadEntireTextFile("qa_cache/saAlreadyLoaded.txt","utf-8")
If (fac.LastMethodSuccess = True) Then
    success = msetAlreadyCopied.FromCompactString(strMsgSet)
End If

Dim numUids As Int32
numUids = mset.Count
Dim sbFlags As New Chilkat.StringBuilder

Dim i As Int32
i = 0
While i < numUids

    // If this UID was not already copied...
    Dim uid As Int32
    uid = mset.GetId(i)
    If (Not msetAlreadyCopied.ContainsId(uid)) Then

        System.DebugLog("copying " + Str(uid) + "...")

        // Get the flags.
        Dim flags As String
        flags = imapSrc.FetchFlags(uid,True)
        If (imapSrc.LastMethodSuccess = False) Then
            System.DebugLog(imapSrc.LastErrorText)
            Return
        End If

        success = sbFlags.SetString(flags)

        // Get the MIME of this email from the source.
        Dim mimeStr As String
        mimeStr = imapSrc.FetchSingleAsMime(uid,True)
        If (imapSrc.LastMethodSuccess = False) Then
            System.DebugLog(imapSrc.LastErrorText)
            Return
        End If

        Dim seen As Boolean
        seen = sbFlags.Contains("\Seen",False)
        Dim flagged As Boolean
        flagged = sbFlags.Contains("\Flagged",False)
        Dim answered As Boolean
        answered = sbFlags.Contains("\Answered",False)
        Dim draft As Boolean
        draft = sbFlags.Contains("\Draft",False)

        success = imapDest.AppendMimeWithFlags("Inbox",mimeStr,seen,flagged,answered,draft)
        If (success <> True) Then
            System.DebugLog(imapDest.LastErrorText)
            Return
        End If

        // Update msetAlreadyCopied with the uid just copied.
        msetAlreadyCopied.InsertId uid

        // Save at every iteration just in case there's a failure..
        strMsgSet = msetAlreadyCopied.ToCompactString()
        success = fac.WriteEntireTextFile("qa_cache/saAlreadyLoaded.txt",strMsgSet,"utf-8",False)
    End If

    i = i + 1
Wend

// Disconnect from the IMAP servers.
success = imapSrc.Disconnect()
success = imapDest.Disconnect()