Use Access to move email messages between folders

Interesting.  Just curious why you'd want to do something like this when all this is built into Outlook already.  Anyways, just curious.

The "easy" way would be to add another linked table to this "target folder".
Now you can use an append query to add the specific email to that new linked table and issue a "delete" query to remove it from the "shared mailbox".

Idea ?

Nic;o)

Hello,

You can write VB code for Outlook. If you want to do that from Access, add a reference to the outlook object library and you can then do all sorts of things, including moving an e-mail from one folder to another. Merely linking to a mailbox is useful for queries, but not very efficient for automation.

To get you started (from the outlook VB help file):

Sub TestOutlook()

    Dim myOlApp As Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim myExplorer As Outlook.Explorer
   
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set myExplorer = myFolder.GetExplorer
    myExplorer.Display
   
End Sub


Cheers!
(°v°)

harfang,

I am not at all familiar with entering code for Outlook.  How do I do this?

harfand,

I figured it out.  What do I do next?

jg0069_2002,

I am creating an Access DB to log emails coming into a mailbox.  This DB will be used by several people.  I want to make it so everything that needs to be done can be done in Access.  That way they will not have to switch back an forth between the two (Access and Outlook).  If you think there is a better way to do this I'm all ears.

Why can't everyone just have access to that mailbox in Outlook?

cobianna,

I provided the above sniplet to get you started, but I can't help you any further than this. I'm not very familiar with the outlook object model, so I would probably provide unefficient solutions and furthermore, I would need to know a whole lot more about your application.

Basically, you will have to surf to the correct folder and identify the current mail from your query in the explorer (myExplorer above) and then find the proper method to move an email. I could surf the help file to find those methods, but I would do no better than you.

Also, now that you know how to program in Access VB for Outlook, you might want to ask further questions about Outlook proper in that TA, I'm sure you will get better answers.

Anyway, good luck!
(°v°)

Nico,

Thanks for the link.  It looks and works great.  I do have another question for you.  I do not know what you mean by "use the linked table method to move them".  How do I do that?

Just define for the Inbox and the sub-folder a linked table in your Access application.
Whencreating a new table chose the "Link" option and select as filetype "Outlook".
You can navigate to the folder you want and Access will show all email's of that folder in a table.
This will allow "normal" queries to manipulate the emails.

Clearer ?

Nic;o)

Nico,
I got what you meant by linking to the mailbox.  I guess what I don't understand is how to programmatically move the email messages to other folder from within the DB.  If you don't mind, could elaborate on that?  

What I envisioned was having a drop down box where the person using the DB could choose a folder to "move the email message" to.  They would then press a botton or something like that to initiate the move.  

Thanks Nico.

As the folders are linked tables, you can use an Append query to "move" a message from one table to another and thus from one foler to another.
Then issue a "delete" on the "from" folder and you have a "real move".

Just try an append query in the query editor to see the effect.

Nic;o)

Nico,

I don't think that you suggestion will work.  I have tried to us an append and delete query to move the email from one to another.  The problem I'm having is that the fields in the linked tables are different than those in my Inbox.  I think the reason this is happening is because I'm using code to pull the emails form the Inbox into Access.  Therefore I'm getting move fields than the default fields that are available when I link to a folder in Outlook.  

Is there a way to use code to move the emails rather than have all these append/delete   queriers.  I have about 10 folders where emails can be moved and I think that even if I can get your suggestion to work, the DB will become so cumberson that it will be difficult to administer.

Let me know your thoughts.

You need to see the move as "different" from the internal (or linked) Access tables.
1) Create linked table to Inbox named "tblIn"
2) Process as required the email in the Inbox (your present code)
3) Create linked table to "Archive" folder named "tblArchive"
4) Issue an INSERT of the processed message from "tblIn" into the the tblArchive
5) Issue a DELETE from the message from "tblIn"

Whe something goes wrong a user can just move the archived mail back into the Inbox to have it processed again.

Nic;o)

Hi  cobianna

1. place this code on a command button
2. strMyString is the string you want to find in the Subject
3. the folder structure assumed is:
"Personal Folders" > "Inbox" > "inInbox" (this is where we will move the items from the Inbox)
4. I had to repeat the loop 2 times, because I noticed it didn't pick all the items the 1st time.


' Make Reference to Outlook Object Library xx.xx

Dim olApp As Outlook.Application
Dim OlMapi As Outlook.NameSpace
Dim OlFolder As Outlook.MAPIFolder
Dim olMail As Object
Dim OlItems As Outlook.Items

Set olApp = CreateObject("Outlook.Application")
Set OlMapi = olApp.GetNamespace("MAPI")

Set OlFolder = OlMapi.Folders("Personal Folders").Folders("Inbox")
Set OlFolderTo = OlMapi.Folders("Personal Folders").Folders("Inbox").Folders("inInbox")
Set OlItems = OlFolder.Items

For Each olMail In OlItems
''    If olMail.UnRead = True Then
        If InStr(olMail.Subject, strMyString) > 0 Then
         olMail.Move OlFolderTo
 '        olMail.Delete
 '        ProcessMail = True
 ''       olMail.UnRead = False 'Mark mail as read, if that's necessary !?
        End If  'InStr
''    End If  'UnRead
Next
For Each olMail In OlItems
''    If olMail.UnRead = True Then
        If InStr(olMail.Subject, strMyString) > 0 Then
         olMail.Move OlFolderTo
 '        olMail.Delete
 '        ProcessMail = True
 ''       olMail.UnRead = False 'Mark mail as read, if that's necessary !?
        End If  'InStr
''    End If  'UnRead
Next


jaffer

> Is there anyway to have a table or query log the emails without deleting them
Yes, follow these steps:

1.
Add a new field to the Mail Table, call it HideMoved and make its Data Type as Yes/No, with a Default value as 0,

2.
change this line:
CurrentDb.Execute ("DELETE * FROM Mail WHERE EntryID = '" & Forms!frmMainMail!sfrmMail!EntryID & "'")
to
CurrentDb.Execute ("UPDATE Mail SET HideMoved = -1 WHERE WHERE EntryID = '" & Forms!frmMainMail!sfrmMail!EntryID & "'")

3.
and the Record Source of sfrmMail should be:

SELECT EntryID, ReceivedTime, Subject, SenderName, CC, Body, Attachments, Action, ActionBy, HideMoved
FROM Mail
WHERE HideMoved=0;

4.
you will have to drag and drop HideMoved to sfrmMail (you can hide the column later, but you can use it manually too, so if you don't want to see an email, just click/check HideMoved, thus it won't show the next time the Form opens/refreshes)

5.
> I also will need to avoid duplicating items when the update occurs
It's built in Nico's mdb (that's why he is 5 times a genius, and I am not even 1 :o)

and for easy reference, here is the link with these revisions:
http://s49.yousendit.com/d.aspx?id=17U8ISU1BIKMU3FDV21P1KIQE6

jaffer

This is the final revision to the code (tested as working),
instead of hardcoding the folder names, now they are selected directly from the Form to the code, thus dynamic, thanks to BlueDevilFan
https://www.experts-exchange.com/questions/21809734/Change-folder-name-dynamically.html#16441129

here is the final code:

    ' 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
Dim strContainer As String
Dim strFolder As String

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")
   
    strContainer = [cmbMap]
    strFolder = [Assigned to Folder]
Set OlFolderTo = OlMapi.Folders(strContainer).Folders(strFolder)

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:
   
    Forms!frmMainMail!sfrmMail!HideMoved = -1
    Forms!frmMainMail!sfrmMail.Requery



and here is the download link:
http://s48.yousendit.com/d.aspx?id=3W422WFX77VP61LYKHHM3OLG9Q


jaffer

jaffer,
I just started getting a new error message when trying to get emails.  It occurs at the following line:
      rst!AttachmentsName = Mid(Attachment9, 2)

The error message is "Run-time Error 3020.  Update or CancelUpdate without AddNew or Edit."

What has happened.

in
Private Sub btnNewMail_Click()

replace these lines:

                'Save attachments in c:\temp
                Attachment9 = ""
                If objCurrentItem.Attachments.Count > 0 Then
                    For intI = 1 To objCurrentItem.Attachments.Count
                        objCurrentItem.Attachments.Item(intI).SaveAsFile ("c:\temp\" & objCurrentItem.Attachments.Item(intI))
                        Attachment9 = Attachment9 & "," & objCurrentItem.Attachments.Item(intI)
                    Next intI
                End If
                rst!AttachmentsName = Mid(Attachment9, 2)
                rst.Update

with these lines:

                'Save attachments in c:\temp
                If objCurrentItem.Attachments.Count > 0 Then
                 Attachment9 = ""
                    For intI = 1 To objCurrentItem.Attachments.Count
                        objCurrentItem.Attachments.Item(intI).SaveAsFile ("c:\temp\" & objCurrentItem.Attachments.Item(intI))
                        Attachment9 = Attachment9 & "," & objCurrentItem.Attachments.Item(intI)
                    Next intI
                 rst!AttachmentsName = Mid(Attachment9, 2)
                End If
                rst.Update


and please let me know if it works,

jaffer

I now get the same error on the following line:
     rst.Update

I can see from your other post
https://www.experts-exchange.com/questions/21815308/Runtime-Error-438-Object-doesn't-support-this-property-or-object.html

that this error is going down from 1 line to another.

I think your problem is not the code, but something outside the code,
Did you do something different today than yesterday(when it was working properly)?
Did you move to a different PC?

check Tootls/Reference for any MISSING reference, which might be causing the problem

jaffer

I haven't done anything different or used a different computer.  I did access the file remotely from home but other than that nothing has changed.  I checked my referrences and they look okay.  Are there certain one's (besides Microsoft Outlook 12.0) that I need?

I have a new error message now.  I'm getting an error on this line.
     rst!ReceivedTime = objCurrentItem.ReceivedTime

"Runtime Error #438.  Object doesn't support this Property or Method"

> I did access the file remotely from home
so are these error messages form the remote PC, or are they now from your PC?
I think what happened was, when you logged in, the Reference took the higher reference of your applications (at home),
then when you used it in the office again, it didn't change it (it is upward compatible, but not downward, so if at home you have Access 2003 and at work you have 2000, then you will have to unselect the Refrenced, close the box, then select them again).

By the way, I never heared of "Microsoft Outlook 12.0", this must be the Access 2007 Beta, mine is Access 2003, and it is "Microsoft Outlook 11.0"


these are the References on my system

Visual Basic For Applications
Microsoft Access 11.0 Object Library
Microsoft Outlook 11.0 Object Library
OLE Automation
Microsoft Visual Basic for Applications Extensibility 5.3
Microsoft DAO 3.6 Object Library

jaffer

My home and work computers are the same.  It's a laptop.  I checked just the referrences you have listed.  That took care of the Error 438.  The code is just bombing out at "rst.Update".

please make sure the references are in the same order

They are.

another good idea will be to compact and repair,
as there might be some garbage entered your Table due to several trials, so compact and repair should take care of it.

I did the compact and repair and now I'm getting the error on:
     rst!AttachmentsName = Mid(Attachment9, 2) which is a line above the "rst.Update".

The error is:
     Run time error #3020.  Update or CancelUpdate without AddNew or Edit"

Yes, that is what I thought,
the code broke here when it had the Addnew executed, but there were no attachments, thus it didn't update and left the record in the Table unclean.

> which is a line above the "rst.Update".
it should be 2 lines above "rst.Update", please use the instructions I gave you here:
https://www.experts-exchange.com/questions/21788340/Use-Access-to-move-email-messages-between-folders.html#16471333

then compact and repair again, before using the code. sometimes you have to compact and repair 2-3 times until Access clears the problem.

jaffer

Please clarify.  Do you want me to recopy the code and replace what I have in there now?  Or do you want me to move the "rst!AttachmentsName = Mid(Attachment9, 2)" up two lines above "rst.Update"?

replace these lines:

                'Save attachments in c:\temp
                Attachment9 = ""
                If objCurrentItem.Attachments.Count > 0 Then
                    For intI = 1 To objCurrentItem.Attachments.Count
                        objCurrentItem.Attachments.Item(intI).SaveAsFile ("c:\temp\" & objCurrentItem.Attachments.Item(intI))
                        Attachment9 = Attachment9 & "," & objCurrentItem.Attachments.Item(intI)
                    Next intI
                End If
                rst!AttachmentsName = Mid(Attachment9, 2)
                rst.Update

with these lines:

                'Save attachments in c:\temp
                If objCurrentItem.Attachments.Count > 0 Then
                 Attachment9 = ""
                    For intI = 1 To objCurrentItem.Attachments.Count
                        objCurrentItem.Attachments.Item(intI).SaveAsFile ("c:\temp\" & objCurrentItem.Attachments.Item(intI))
                        Attachment9 = Attachment9 & "," & objCurrentItem.Attachments.Item(intI)
                    Next intI
                 rst!AttachmentsName = Mid(Attachment9, 2)
                End If
                rst.Update


there are 2 changes that belong to Attachment9, thus please copy and replace.

jaffer

That appreas to have worked.  I will try it out and let you know if I stumble accross any other issues.  Thanks.

ah, phew, I am glad it worked,
but I asked you to do this change 3 hours ago!

oh well, it's past my bed time :o(

I will catch with you in the morning, if you have further issues :o)

jaffer

I did make the change.  I promise.  Thanks for you help.  How do I get you the points?  

Hey No sweat.

Points!

You cannot award points for a closed question,
so if you have further questions, post it, and most of the Experts can do better than me,
but if you want my attention, then you can send me an email with the link to the question,
my email is in my profile, just click my name and you will see the info.

Good luck, in your project.

jaffer

jaffer,

I am getting an error on:
     rst!AttachmentsName = Mid(Attachment9, 2) which is a line above the "rst.Update".

The error is:
     Run time error #3020.  Update or CancelUpdate without AddNew or Edit"

HELP!!!

jaffer,

Additionally, when I move emails, it is moving emails other than the one I working on.  This creates a hug problem for me because emails end up in the wrong folder.  I have posted the above in a new question so I can award you additional points for helping me.  I look forward to your response.