B4X

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. B4X

Dim success As Boolean = False

Dim imapSrc As ChilkatImap
imapSrc.Initialize("imapSrc")

'  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
    Log(imapSrc.LastErrorText)
    Return
End If


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


Dim imapDest As ChilkatImap
imapDest.Initialize("imapDest")

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


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


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


Dim fetchUids As Boolean = True

'  Get the set of UIDs for all emails on the source server.
Dim mset As ChilkatMessageSet = imapSrc.Search("ALL", fetchUids)
If imapSrc.LastMethodSuccess <> True Then
    Log(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 ChilkatFileAccess
fac.Initialize
Dim msetAlreadyCopied As ChilkatMessageSet
msetAlreadyCopied.Initialize
Dim strMsgSet As String = fac.ReadEntireTextFile("qa_cache/saAlreadyLoaded.txt", "utf-8")
If fac.LastMethodSuccess = True Then
    msetAlreadyCopied.FromCompactString(strMsgSet)
End If


Dim numUids As Int = mset.Count
Dim sbFlags As ChilkatStringBuilder
sbFlags.Initialize

Dim i As Int = 0
Do While i < numUids

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

        Log("copying " & uid & "...")

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

        sbFlags.SetString(flags)

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


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

        success = imapDest.AppendMimeWithFlags("Inbox", mimeStr, seen, flagged, answered, draft)
        If success <> True Then
            Log(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
        fac.WriteEntireTextFile("qa_cache/saAlreadyLoaded.txt", strMsgSet, "utf-8", False)
    End If


    i = i + 1
Loop


'  Disconnect from the IMAP servers.
success = imapSrc.Disconnect
success = imapDest.Disconnect