Chilkat HOME Android™ Classic ASP C C++ C# Mono C# .NET Core C# C# UWP/WinRT DataFlex Delphi ActiveX Delphi DLL Visual FoxPro Java Lianja MFC Objective-C Perl PHP ActiveX PHP Extension PowerBuilder PowerShell PureBasic CkPython Chilkat2-Python Ruby SQL Server Swift 2 Swift 3,4,5... Tcl Unicode C Unicode C++ Visual Basic 6.0 VB.NET VB.NET UWP/WinRT VBScript Xojo Plugin Node.js Excel Go
(Excel) Copy Email from one IMAP Account to AnotherDemonstrates how to copy the email in a mailbox from one account to another.
Dim imapSrc As Chilkat.Imap Set imapSrc = Chilkat.NewImap ' This example assumes Chilkat Imap to have been previously unlocked. ' See Unlock Imap 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 Debug.Print imapSrc.LastErrorText Exit Sub End If ' Login to the source IMAP server success = imapSrc.Login("MY-IMAP-LOGIN","MY-IMAP-PASSWORD") If (success <> True) Then Debug.Print imapSrc.LastErrorText Exit Sub End If Dim imapDest As Chilkat.Imap Set imapDest = Chilkat.NewImap ' Connect to our destination IMAP server. imapDest.Ssl = True imapDest.Port = 993 success = imapDest.Connect("MY-IMAP-DOMAIN2") If (success <> True) Then Debug.Print imapDest.LastErrorText Exit Sub End If ' Login to the destination IMAP server success = imapDest.Login("MY-IMAP-LOGIN2","MY-IMAP-PASSWORD2") If (success <> True) Then Debug.Print imapDest.LastErrorText Exit Sub End If ' Select a source IMAP mailbox on the source IMAP server success = imapSrc.SelectMailbox("Inbox") If (success <> True) Then Debug.Print imapSrc.LastErrorText Exit Sub End If fetchUids = True ' Get the set of UIDs for all emails on the source server. Set mset = imapSrc.Search("ALL",fetchUids) If (imapSrc.LastMethodSuccess <> True) Then Debug.Print imapSrc.LastErrorText Exit Sub 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 Chilkat.FileAccess Set fac = Chilkat.NewFileAccess Dim msetAlreadyCopied As Chilkat.MessageSet Set msetAlreadyCopied = Chilkat.NewMessageSet strMsgSet = fac.ReadEntireTextFile("qa_cache/saAlreadyLoaded.txt","utf-8") If (fac.LastMethodSuccess = True) Then Dim success As Boolean success = msetAlreadyCopied.FromCompactString(strMsgSet) End If numUids = mset.Count Dim sbFlags As Chilkat.StringBuilder Set sbFlags = Chilkat.NewStringBuilder i = 0 Do While i < numUids ' If this UID was not already copied... uid = mset.GetId(i) If (Not msetAlreadyCopied.ContainsId(uid)) Then Debug.Print "copying "; uid; "..." ' Get the flags. flags = imapSrc.FetchFlags(uid,True) If (imapSrc.LastMethodSuccess = False) Then Debug.Print imapSrc.LastErrorText Exit Sub End If success = sbFlags.SetString(flags) ' Get the MIME of this email from the source. mimeStr = imapSrc.FetchSingleAsMime(uid,True) If (imapSrc.LastMethodSuccess = False) Then Debug.Print imapSrc.LastErrorText Exit Sub End If seen = sbFlags.Contains("\Seen",False) flagged = sbFlags.Contains("\Flagged",False) answered = sbFlags.Contains("\Answered",False) draft = sbFlags.Contains("\Draft",False) success = imapDest.AppendMimeWithFlags("Inbox",mimeStr,seen,flagged,answered,draft) If (success <> True) Then Debug.Print imapDest.LastErrorText Exit Sub 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 Loop ' Disconnect from the IMAP servers. success = imapSrc.Disconnect() success = imapDest.Disconnect() |
© 2000-2022 Chilkat Software, Inc. All Rights Reserved.