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
Random Solutions  
 
programming4us programming4us