Tracking Mail items being moved to folders

[novemberskye]

Hi All,

I am looking to track some data when mail items are moved in Shared mail account to any subfolders within the account.
the code below is fired via Items_ItemAdd(ByVal item As Object)
- I don't want this restriction. I would like to track every time an item is moved anywhere within the shared mail account.

Issues:
1. Working on one by one movement from Inbox to 'Actioned' folder but not for multiple selected items (it's adding the number of selection correctly but the data it's recording is the same as the first item)
2. Restricted to moving from Inbox to Actioned

Help needed:
1. Code to allow to get "from" and "to" folders within the mail account
1.1 Code to get "from" folder name and "to" folder name
2. Code to record mail item data allowing multiple selected mail items


Appreciate your help in advance!!!

Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim itm As Object
Dim msg As Outlook.MailItem
Dim sTime As String
Dim sSubj As String
Dim sCat As String
Dim sConID As String
 
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("contoso@microsoft.com.au") 
Set objFolder = objFolder.Folders("Inbox").Folders("Actioned")

  Set db = DBEngine.OpenDatabase("S:\....\dbo.mailtrackinglog.accdb")
  Set rs = db.OpenRecordset("tbl_mailmovements", dbOpenTable)

For Each msg In olApp.ActiveExplorer.Selection
Set msg = olApp.ActiveExplorer.Selection(1)
rcvdTime= msg.ReceivedTime
mSubj = msg.Subject
mConvId= msg.ConversationID
mCateg = msg.Categories

Next msg

with rst
.AddNew
.Fields( )  =  rcvdTime
.Fields( )  = mSubj
.Fields( )  = mConvId
.Fields( )  = mCateg

.Update

End With

 

[Diane Poremsky]

- I don't want this restriction. I would like to track every time an item is moved anywhere within the shared mail account.

The only way to do it in VBA is to watch each folder (added to app startup) - you can use a bunch of itemadds that point to the working macro - unless you want to do it hourly or on a schedule - then you could walk all folders looking for new items.

sub Items_ItemAdd(ByVal item As Object)
trackingmacro item
end sub

sub SentItems_ItemAdd(ByVal item As Object)
trackingmacro item
end sub

etc.

For Each msg In olApp.ActiveExplorer.Selection
Set msg = olApp.ActiveExplorer.Selection(1)

the first line says to do all items in the selection, but the second line says to do the first selection. if you are using itemadd, you'd only want to do the newly added item - remove those lines and either use set msg = item or change msg to item

how to use itemadd macros: How to use an ItemAdd Macro

 

[novemberskye]

the first line says to do all items in the selection, but the second line says to do the first selection. if you are using itemadd, you'd only want to do the newly added item - remove those lines and either use set msg = item or change msg to item

how to use itemadd macros: How to use an ItemAdd Macro

updated the 'for' statement to For x = 1 To myOlSel.Count
when I get to x = 2 I get an operation failed error

 

[Diane Poremsky]

Do you want to run it on a selection? if so, use
For Each msg In olApp.ActiveExplorer.Selection

but get rid of this line -
Set msg = olApp.ActiveExplorer.Selection(1)

use with msg
'''do whatever
end with

next

The second macro on this page shows how to run macros on a selection : Working with All Items in a Folder or Selected Items

The problem is that you are mixing types of macros - if using an itemadd macro, you won't work with selections.

 

[novemberskye]

See updated code below
Been knocked to a different path with new issues I am unable to solve even after half a day of research and testing.

the issue I am having is getting looping through the selected / moved item in the Destination Folder by each EntryID in the Item_Add event

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("## Shrared email account here ##")
Set objFolder = objFolder.Folders("Inbox").Folders("## SUBFOLDER HERE ##")

Dim olApp As Outlook.Application

  Set olApp = Outlook.Application
  Set Items = objFolder.Items
  objFolder.Items.Sort "[LastModificationTime]", True  ''''<--- does not look like it's working
 
End Sub


---------------------------------------

Public Sub Items_ItemAdd(ByVal Item As Object)

  Dim myNameSpace As Outlook.NameSpace
  Dim objFolder As Outlook.MAPIFolder
  Dim myDestFolder As Outlook.Folder
  Dim myDestItems As Outlook.Items

    Set myNameSpace = Application.GetNamespace("MAPI")
    Set objFolder = myNameSpace.Folders("## Shrared email account here ##")
    'Set objFolder = objFolder.Folders("Inbox")
   
  Set myInbox = objFolder.Folders("Inbox")
  Set myItems = myInbox.Items
  Set myDestFolder = objFolder.Folders("Inbox").Folders("## SUBFOLDER HERE ##")
  Set myDestItems = myDestFolder.Items

  On Error GoTo 0

    Dim myOlApp As Outlook.Application
    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim oMail As Outlook.MailItem
    Dim x, i, j As Integer
    Dim EntryIDCollection As String
    Dim myOlMItem As Outlook.MailItem
    Dim myOlAtts As Outlook.Attachments

    Set myOlApp = Outlook.Application
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection

 For Each Item In myOlSel
 EntryIDCollection = Item.EntryID & ","
 Next Item

  Set objNS = Application.GetNamespace("MAPI")
  strIDs = Split(EntryIDCollection, ",")
  For intX = 0 To UBound(strIDs)
  cMailItem = strIDs(intX)
  Set objEmail = objNS.GetItemFromID(cMailItem, Item.Parent.StoreID) '''''<----- ERROR HERE not able to get the mailitem by EntryID

   Set MyCurrentFolder = myOlExp.CurrentFolder
   Set msg = objEmail
   sTime = objEmail.ReceivedTime
   sSubj = objEmail.Subject
   sConID = objEmail.ConversationID
   sCat = objEmail.Categories
   sLMod = objEmail.LastModificationTime
   sFol = MyCurrentFolder
 

## 
Code here to upload mail item data to an access database
##

End sub

 

[Michael Bauer]

As Diane mentioned, you´re mixing different code. Use ItemAdd, if you want to handle on item added to a folder. Use the loop through selected items if you want to handle items selected by the user.

The For Each loop already loops through the items, giving you a ref on each selected item. Why do you first read only the IDs and then want to loop through that again?

Anyway, after the loop has finished the item variable is set to nothing. Thus you get an error trying to read a property of the item.

Since all items are from the same store, you can read the storeid from the folder object.