Visual FoxPro
Visual FoxPro
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.Chilkat Visual FoxPro Downloads
LOCAL lnSuccess
LOCAL loImapSrc
LOCAL loImapDest
LOCAL lnFetchUids
LOCAL loMset
LOCAL loFac
LOCAL loMsetAlreadyCopied
LOCAL lcStrMsgSet
LOCAL lnNumUids
LOCAL loSbFlags
LOCAL i
LOCAL lnUid
LOCAL lcFlags
LOCAL lcMimeStr
LOCAL lnSeen
LOCAL lnFlagged
LOCAL lnAnswered
LOCAL lnDraft
lnSuccess = 0
loImapSrc = CreateObject('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.
loImapSrc.Ssl = 1
loImapSrc.Port = 993
lnSuccess = loImapSrc.Connect("MY-IMAP-DOMAIN")
IF (lnSuccess <> 1) THEN
? loImapSrc.LastErrorText
RELEASE loImapSrc
CANCEL
ENDIF
* Login to the source IMAP server
lnSuccess = loImapSrc.Login("MY-IMAP-LOGIN","MY-IMAP-PASSWORD")
IF (lnSuccess <> 1) THEN
? loImapSrc.LastErrorText
RELEASE loImapSrc
CANCEL
ENDIF
loImapDest = CreateObject('Chilkat.Imap')
* Connect to our destination IMAP server.
loImapDest.Ssl = 1
loImapDest.Port = 993
lnSuccess = loImapDest.Connect("MY-IMAP-DOMAIN2")
IF (lnSuccess <> 1) THEN
? loImapDest.LastErrorText
RELEASE loImapSrc
RELEASE loImapDest
CANCEL
ENDIF
* Login to the destination IMAP server
lnSuccess = loImapDest.Login("MY-IMAP-LOGIN2","MY-IMAP-PASSWORD2")
IF (lnSuccess <> 1) THEN
? loImapDest.LastErrorText
RELEASE loImapSrc
RELEASE loImapDest
CANCEL
ENDIF
* Select a source IMAP mailbox on the source IMAP server
lnSuccess = loImapSrc.SelectMailbox("Inbox")
IF (lnSuccess <> 1) THEN
? loImapSrc.LastErrorText
RELEASE loImapSrc
RELEASE loImapDest
CANCEL
ENDIF
lnFetchUids = 1
* Get the set of UIDs for all emails on the source server.
loMset = loImapSrc.Search("ALL",lnFetchUids)
IF (loImapSrc.LastMethodSuccess <> 1) THEN
? loImapSrc.LastErrorText
RELEASE loImapSrc
RELEASE loImapDest
CANCEL
ENDIF
* Load the complete set of UIDs that were previously copied.
* We dont' want to copy any of these to the destination.
loFac = CreateObject('Chilkat.FileAccess')
loMsetAlreadyCopied = CreateObject('Chilkat.MessageSet')
lcStrMsgSet = loFac.ReadEntireTextFile("qa_cache/saAlreadyLoaded.txt","utf-8")
IF (loFac.LastMethodSuccess = 1) THEN
loMsetAlreadyCopied.FromCompactString(lcStrMsgSet)
ENDIF
lnNumUids = loMset.Count
loSbFlags = CreateObject('Chilkat.StringBuilder')
i = 0
DO WHILE i < lnNumUids
* If this UID was not already copied...
lnUid = loMset.GetId(i)
IF (NOT loMsetAlreadyCopied.ContainsId(lnUid)) THEN
? "copying " + STR(lnUid) + "..."
* Get the flags.
lcFlags = loImapSrc.FetchFlags(lnUid,1)
IF (loImapSrc.LastMethodSuccess = 0) THEN
? loImapSrc.LastErrorText
RELEASE loImapSrc
RELEASE loImapDest
RELEASE loFac
RELEASE loMsetAlreadyCopied
RELEASE loSbFlags
CANCEL
ENDIF
loSbFlags.SetString(lcFlags)
* Get the MIME of this email from the source.
lcMimeStr = loImapSrc.FetchSingleAsMime(lnUid,1)
IF (loImapSrc.LastMethodSuccess = 0) THEN
? loImapSrc.LastErrorText
RELEASE loImapSrc
RELEASE loImapDest
RELEASE loFac
RELEASE loMsetAlreadyCopied
RELEASE loSbFlags
CANCEL
ENDIF
lnSeen = loSbFlags.Contains("\Seen",0)
lnFlagged = loSbFlags.Contains("\Flagged",0)
lnAnswered = loSbFlags.Contains("\Answered",0)
lnDraft = loSbFlags.Contains("\Draft",0)
lnSuccess = loImapDest.AppendMimeWithFlags("Inbox",lcMimeStr,lnSeen,lnFlagged,lnAnswered,lnDraft)
IF (lnSuccess <> 1) THEN
? loImapDest.LastErrorText
RELEASE loImapSrc
RELEASE loImapDest
RELEASE loFac
RELEASE loMsetAlreadyCopied
RELEASE loSbFlags
CANCEL
ENDIF
* Update msetAlreadyCopied with the uid just copied.
loMsetAlreadyCopied.InsertId(lnUid)
* Save at every iteration just in case there's a failure..
lcStrMsgSet = loMsetAlreadyCopied.ToCompactString()
loFac.WriteEntireTextFile("qa_cache/saAlreadyLoaded.txt",lcStrMsgSet,"utf-8",0)
ENDIF
i = i + 1
ENDDO
RELEASE loMset
* Disconnect from the IMAP servers.
lnSuccess = loImapSrc.Disconnect()
lnSuccess = loImapDest.Disconnect()
RELEASE loImapSrc
RELEASE loImapDest
RELEASE loFac
RELEASE loMsetAlreadyCopied
RELEASE loSbFlags