C
cnByYXRpa25v
Hi guys,
I have a macro that will move all email sent with "sendonbehalf" properties
to the group mailbox. I found it on someone post and it has been working like
a charm until I installed Office SP2. It doesn't work anymore. Do anyone
might know what is the issue? I have try re-install Office then also SP2 with
no joy.
Below is the code
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 - group")
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 = "group" Then
Set DestinationFolder = Application.Session.GetFolderFromID(SentEntryID,
SentStoreID)
MailItem.Move (DestinationFolder)
End If
End If
Set MailItem = Nothing
End Sub
Any suggestion or thinking are welcomed.
Thanks.
I have a macro that will move all email sent with "sendonbehalf" properties
to the group mailbox. I found it on someone post and it has been working like
a charm until I installed Office SP2. It doesn't work anymore. Do anyone
might know what is the issue? I have try re-install Office then also SP2 with
no joy.
Below is the code
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 - group")
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 = "group" Then
Set DestinationFolder = Application.Session.GetFolderFromID(SentEntryID,
SentStoreID)
MailItem.Move (DestinationFolder)
End If
End If
Set MailItem = Nothing
End Sub
Any suggestion or thinking are welcomed.
Thanks.