Copying Emails using drag and drop

[Laser]

After extensive searching and googling, I have to conclude that I cannot find an answer to my query. So I turn to the experts in the hope they have an answer.

I have a local POP account within Outlook 2003 and an IMAP account. I often move mail within the local account and would like it to be reflected within the IMAP account. For example: if I drag an email from my inbox on the local account (POP) to a completed folder also within the local account, I would like the completed folders' added email to be copied to a subfolder within the IMAP account. Even better would be if Outlook detects when an email has been removed from the local folder and also updates the IMAP account.

Simply put, I would like folders in the local account when updated to be synchronised with the same folders in the IMAP account. I have experimented with using the itemadd property and have cobbled together the following which triggers when ever and email is added to a local folder but that is as far as I have got so far.

Private WithEvents Items As Outlook.Items
Private WithEvents Items1 As Outlook.Items
Private WithEvents Items2 As Outlook.Items
Private WithEvents Items3 As Outlook.Items
Private WithEvents Items4 As Outlook.Items
Private WithEvents Items5 As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).Items
Set Items1 = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Laser").Items
Set Items2 = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Orders Received").Items
Set Items3 = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("Personal").Items
Set Items4 = GetNS(olApp).GetDefaultFolder(olFolderInbox).Folders("TempStore").Items
End Sub
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
MsgBox "You moved an item into the Inbox folder."
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Private Sub Items1_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
MsgBox "You moved an item into the Laser folder."
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Private Sub Items2_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
MsgBox "You moved an item into the 'Orders Received Folder."
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Private Sub Items3_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
MsgBox "You moved an item into the Personal folder."
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Private Sub Items4_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
MsgBox "You moved an item into the 'TempStore' folder."
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

One other area that I am considering, but having a lot of difficulty in finding a great deal of information about, is the utilisation of flags or categories to mark emails placed in a local folder with a flag or category and then using a VBA routine to find all emails so marked and to copy them to the IMAP equivalent folder. I would be grateful if anyone can indicate if I am on the right track. Many thanks in anticipation.

 

[Diane Poremsky]

Does the macro work? If not, comment out all of the error handlers so you can see where the problem is.

Triggering on a flag or category might be easier- the category name could identify the folder and you could use one macro with the folder set via a variable (the category).

if the macro doesn't work, make sure you click in the startup macro and click Run.

 

[Laser]

Hello Diane, Thank you for your response. The code posted works fine. Whenever an email is dropped or sent to a monitored folder the itemadd trigger works fine and the MsgBox fires with "You moved an item into the 'Named Folder' folder." The problem I have is how to copy the email that was added to the local Outlook folder and triggered by the itemadd property to the IMAP folder. Cannot work out the code required for this and cannot find sensible references or code elsewhere.