Hi guys,
I found this script on the net, which is supposed to move any sent mail on behalf of someone from my sent box to the on behalf of persons sent box. However when I run it I get a debug error which I have no idea how to fix.. Would there be anyone out there who can help???
Private SentEntryID As String
Private SentStoreID As String
Private WithEvents objSentItems As Items
Private MailItem As Outlook.MailItem
Public Sub Application_Startup()
'Retrieve ID for accessing non-default sent folder
getStoreFolderID ("Mailbox – Finanz")
Set objSentItems = Application.Session.GetDefaultFolder(olFolderSentMail).Items
End Sub
Function getStoreFolderID(StoreName)
'Gets the Shared Account Sent Folder
Dim Store As Object
Dim StoreFolder As Object
Dim i As Integer
Set Store = Application.GetNamespace("mapi").Folders
For Each StoreFolder In Store
If StoreFolder.Name = StoreName Then
For i = 1 To StoreFolder.Folders.Count
If StoreFolder.Folders(i).Name = "Sent Items" Then
SentEntryID = StoreFolder.Folders(i).EntryID
SentStoreID = StoreFolder.Folders(i).StoreID
Exit For
End If
Next
Exit For
End If
Next
Set Store = Nothing
Set StoreFolder = Nothing
End Function
Private Sub objSentItems_ItemAdd(ByVal Item As Object)
'Fired when something is added to personal "Sent Mail" folder
If TypeOf Item Is Outlook.MailItem Then
With Item
Set MailItem = Application.GetNamespace("mapi").GetItemFromID(.EntryID, .Parent.StoreID)
End With
If MailItem.SentOnBehalfOfName = "Finanz" Then
Set DestinationFolder = Application.Session.GetFolderFromID(SentEntryID, SentStoreID) MailItem.Move (DestinationFolder)
End If
End If
Set MailItem = Nothing
End Sub
Debug stops at the line in red with the error message " Could not open the item. Try Again"
Thanks for any help in advance
Mr Tanner