|
Question : Use Access to move email messages between folders
|
|
I have an Access DB that links to a shared mailbox in Outlook (this is an Inbox other than my default Inbox). I have query that logs the receipt times of each email coming into the mailbox. This DB is linked to shared mailbox on our server. I want to know if it is possible to create code that will have MS Access move specific emails to specific folder within this shared mailbox?
I have already created a form that will allow the user to view each email as a separate record. They will then select a folder to move the email to from a drop down box on this form. I want Access to then move the email to this folder and out of the Inbox within Outlook. If anyone has any idea how to do this I would love to hear some of your suggestions.
I'm also curious if there is a better way to get the emails out of Outlook other than linking to the Inbox.
|
|
Answer : Use Access to move email messages between folders
|
|
cobianna
With permission from Nico, I have used his mdb to add your requirement
here is the download link: http://s42.yousendit.com/d.aspx?id=1UG699FU9KG3T0YDQ7C6I6NF72
follow the 3 steps as mentioned in his frmMainMail, then when all the emails are in the subform, select the from the "To Folder" you destination folder, then click/select a record from the subform, and click on the Move mail command button, this will move that email from the Inbox to your destination directory, and remove it from your subform too (give it a second or 2 to update).
I would like to thank Nico for his guesture, thanks buddy :o)
The rest of the info was obtained from another Q: http://www.experts-exchange.com/Databases/MS_Access/Q_21807451.html
and this is the working code:
Private Sub cmdMoveEmail_Click() On Error GoTo Err_cmdMoveEmail_Click
' Make Reference to Outlook Object Library xx.xx
Dim olApp As Outlook.Application Dim OlMapi As Outlook.NameSpace Dim OlFolder As Outlook.MAPIFolder Dim OlFolderTo As Outlook.MAPIFolder Dim olMail As Object Dim OlItems As Outlook.Items
Set olApp = CreateObject("Outlook.Application") Set OlMapi = olApp.GetNamespace("MAPI")
' The From folder, which is fixed to the Inbox Set OlFolder = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Inbox")
' The To folder If [Assigned to Folder] = "Donna Recker" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Donna Recker")
ElseIf [Assigned to Folder] = "Herman Lewis" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Herman Lewis") ElseIf [Assigned to Folder] = "Inbox" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Inbox") ElseIf [Assigned to Folder] = "Julie Ellison" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Julie Ellison") ElseIf [Assigned to Folder] = "Julie Salyers" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Julie Salyers") ElseIf [Assigned to Folder] = "Lamont Sams" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Lamont Sams") ElseIf [Assigned to Folder] = "Melanie Stephens" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Melanie Stephens") ElseIf [Assigned to Folder] = "Paper 4998 Invoices" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Paper 4998 Invoices") ElseIf [Assigned to Folder] = "Plaxo Backup" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("Plaxo Backup") ElseIf [Assigned to Folder] = "PROBLEM INVOICES" Then Set OlFolderTo = OlMapi.Folders("Mailbox - TLMS Cost").Folders("PROBLEM INVOICES") End If
Set OlItems = OlFolder.Items
For Each olMail In OlItems '' If olMail.UnRead = True Then If olMail.Subject = Forms!frmMainMail!sfrmMail!Subject And _ olMail.Body = Forms!frmMainMail!sfrmMail!Body Then olMail.Move OlFolderTo ' olMail.UnRead = True GoTo ExitFor1 ' olMail.Delete ' ProcessMail = True '' olMail.UnRead = False 'Mark mail as read, if that's necessary !? End If 'InStr '' End If 'UnRead Next ExitFor1:
' Mark as unRead Set OlItems = OlFolderTo.Items For Each olMail In OlItems If olMail.Subject = Forms!frmMainMail!sfrmMail!Subject And _ olMail.Body = Forms!frmMainMail!sfrmMail!Body Then olMail.UnRead = True GoTo ExitFor2 End If Next ExitFor2:
CurrentDb.Execute ("DELETE * FROM Mail WHERE EntryID = '" & Forms!frmMainMail!sfrmMail!EntryID & "'") Forms!frmMainMail!sfrmMail.Requery
Exit_cmdMoveEmail_Click: Exit Sub
Err_cmdMoveEmail_Click: MsgBox Err.Description Resume Exit_cmdMoveEmail_Click End Sub
jaffer
|
|
|
|