(VBScript) Copy Email from one IMAP Account to Another

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

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

Dim fso, outFile
Set fso = CreateObject("Scripting.FileSystemObject")
'Create a Unicode (utf-16) output text file.
Set outFile = fso.CreateTextFile("output.txt", True, True)

' For versions of Chilkat < 10.0.0, use CreateObject("Chilkat_9_5_0.Imap")
set imapSrc = CreateObject("Chilkat.Imap")

' This example assumes Chilkat Imap to have been previously unlocked.
' See Unlock Imap for sample code.

' Connect to our source IMAP server.
imapSrc.Ssl = 1
imapSrc.Port = 993
success = imapSrc.Connect("MY-IMAP-DOMAIN")
If (success <> 1) Then
    outFile.WriteLine(imapSrc.LastErrorText)
    WScript.Quit
End If

' Login to the source IMAP server
success = imapSrc.Login("MY-IMAP-LOGIN","MY-IMAP-PASSWORD")
If (success <> 1) Then
    outFile.WriteLine(imapSrc.LastErrorText)
    WScript.Quit
End If

' For versions of Chilkat < 10.0.0, use CreateObject("Chilkat_9_5_0.Imap")
set imapDest = CreateObject("Chilkat.Imap")

' Connect to our destination IMAP server.
imapDest.Ssl = 1
imapDest.Port = 993
success = imapDest.Connect("MY-IMAP-DOMAIN2")
If (success <> 1) Then
    outFile.WriteLine(imapDest.LastErrorText)
    WScript.Quit
End If

' Login to the destination IMAP server
success = imapDest.Login("MY-IMAP-LOGIN2","MY-IMAP-PASSWORD2")
If (success <> 1) Then
    outFile.WriteLine(imapDest.LastErrorText)
    WScript.Quit
End If

' Select a source IMAP mailbox on the source IMAP server
success = imapSrc.SelectMailbox("Inbox")
If (success <> 1) Then
    outFile.WriteLine(imapSrc.LastErrorText)
    WScript.Quit
End If

fetchUids = 1

' Get the set of UIDs for all emails on the source server.
' mset is a Chilkat.MessageSet
Set mset = imapSrc.Search("ALL",fetchUids)
If (imapSrc.LastMethodSuccess <> 1) Then
    outFile.WriteLine(imapSrc.LastErrorText)
    WScript.Quit
End If

' Load the complete set of UIDs that were previously copied.
' We dont' want to copy any of these to the destination.
' For versions of Chilkat < 10.0.0, use CreateObject("Chilkat_9_5_0.FileAccess")
set fac = CreateObject("Chilkat.FileAccess")
' For versions of Chilkat < 10.0.0, use CreateObject("Chilkat_9_5_0.MessageSet")
set msetAlreadyCopied = CreateObject("Chilkat.MessageSet")
strMsgSet = fac.ReadEntireTextFile("qa_cache/saAlreadyLoaded.txt","utf-8")
If (fac.LastMethodSuccess = 1) Then
    success = msetAlreadyCopied.FromCompactString(strMsgSet)
End If

numUids = mset.Count
' For versions of Chilkat < 10.0.0, use CreateObject("Chilkat_9_5_0.StringBuilder")
set sbFlags = CreateObject("Chilkat.StringBuilder")

i = 0
Do While i < numUids

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

        outFile.WriteLine("copying " & uid & "...")

        ' Get the flags.
        flags = imapSrc.FetchFlags(uid,1)
        If (imapSrc.LastMethodSuccess = 0) Then
            outFile.WriteLine(imapSrc.LastErrorText)
            WScript.Quit
        End If

        success = sbFlags.SetString(flags)

        ' Get the MIME of this email from the source.
        mimeStr = imapSrc.FetchSingleAsMime(uid,1)
        If (imapSrc.LastMethodSuccess = 0) Then
            outFile.WriteLine(imapSrc.LastErrorText)
            WScript.Quit
        End If

        seen = sbFlags.Contains("\Seen",0)
        flagged = sbFlags.Contains("\Flagged",0)
        answered = sbFlags.Contains("\Answered",0)
        draft = sbFlags.Contains("\Draft",0)

        success = imapDest.AppendMimeWithFlags("Inbox",mimeStr,seen,flagged,answered,draft)
        If (success <> 1) Then
            outFile.WriteLine(imapDest.LastErrorText)
            WScript.Quit
        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",0)
    End If

    i = i + 1
Loop

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

outFile.Close