User-select to copy inbox items to specified folder?

[Anita Gupta]

Hello,

I need to prompt the user to find out whether to add a mail item from
his/her inbox to public folder. I need to do this with both incoming and
outgoing email. I accomplished this very easily for outgoing mail using the
ItemAdd event on the Sent Items folder to display a dialog box asking
whether to copy the item to the specified folder. However, I can't use this
with the inbox because: #1 I can't prompt the user before they read it and
find out if it should be sent to the folder and #2 because the user may get
several mails at once and I can't barrage them with dialog boxes for mail
they haven't read yet. I also can't prompt the user everytime he/she opens
the same item if they have already said "no" or worse yet... "yes" and send
a copy there multiple times. Can someone tell me of a good event to use
(after the user has read the item) that I could prompt with. Also, I don't
want to use a custom form because that would disable the auto-preview that
most of them use. I'd like the events to be placed in the ThisOutlookSession
module. I'm sure that I can come up with a suitable standard property to set
indicating that the user has been asked before and not to ask again once I
display the initial prompt in the first place.

Any suggestions would be appreciated.

Thanks,

Anita

 

[Sue Mosher [MVP]]

Take a look at the Inspectors.NewInspector and Explorer.SelectionChange (for preview pane reading) events.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers

 

[Anita Gupta]

Thank you Sue. I ended up using the SelectionChange Event because it fires
no matter how the user reads the message. I'm now just having a problem
handling the errors for when a user deletes an item without selecting a
different one first. Here is my code for prompting the user to Journal the
item only after he/she has read the item and moved on to the next message.
It gives an error if the user deletes the item in order to move to the next
item. This is due to the "LastSelected.Save" lines. This is understandable,
but my error handling hasn't worked around this yet. Is there a way to check
if my last selected has been deleted before processing the rest of the code?
Any advice would be appreciated.

Thanks!

Anita

Dim LastSelected As MailItem
Dim LSEntryID As String
Public WithEvents myOlExp As Outlook.Explorer

Private Sub Application_Startup()
Initialize_handler
End Sub

Public Sub Initialize_handler()

Set myOlInboxItems =
Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
Set myOlExp = Application.ActiveExplorer

End Sub

Private Sub myOlExp_SelectionChange()

If myOlExp.CurrentFolder.Name = "Inbox" And
myOlExp.Selection(1).MessageClass = "IPM.Note" Then
ProcessInbox
End If

End Sub

Sub ProcessInbox()

Dim JournalResponse As Integer
Dim NS As NameSpace
Dim newJournalFolder As MAPIFolder
Dim LSLocationItem As MailItem
Dim LSLocation As MAPIFolder

Set NS = Application.GetNamespace("MAPI")
Set newJournalFolder = NS.Folders("Public Folders").Folders("All Public
Folders").Folders("Public Journal")
Set InboxItems = NS.GetDefaultFolder(olFolderInbox).Items


If LastSelected Is Nothing Then
LSEntryID = myOlExp.Selection(1).EntryID
Set LastSelected = NS.GetItemFromID(LSEntryID)
Else
If Not LastSelected.EntryID = myOlExp.Selection(1).EntryID Then
If Not LastSelected.BillingInformation = "J" Then
LastSelected.BillingInformation = "J"
LastSelected.Save
JournalResponse = MsgBox("Would you like to Journal: '" &
LastSelected.Subject & "'?", vbYesNo, "Continue")
If JournalResponse = 6 Then
LastSelected.Copy
LastSelected.Move newJournalFolder
'MsgBox "The Inbox Item: '" & LastSelected.Subject & "' has
been moved to the Public Folder."
LSEntryID = myOlExp.Selection(1).EntryID
Set LastSelected = NS.GetItemFromID(LSEntryID)
Else
Set LastSelected = NS.GetItemFromID(LSEntryID)
LastSelected.BillingInformation = "J"
LastSelected.Save
LSEntryID = myOlExp.Selection(1).EntryID
Set LastSelected = NS.GetItemFromID(LSEntryID)
End If
Else
If NS.GetDefaultFolder(olFolderInbox).Items.Count > 0 Then
LSEntryID = myOlExp.Selection(1).EntryID
Set LastSelected = NS.GetItemFromID(LSEntryID)
End If
End If
End If
End If

End Sub
Take a look at the Inspectors.NewInspector and Explorer.SelectionChange (for
preview pane reading) events.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers

 

[Sue Mosher [MVP]]

I think you probably just need to check the Selection.Count a little more often to make sure you really have a selected item. Is there a reason why you're using

LSEntryID = myOlExp.Selection(1).EntryID
Set LastSelected = NS.GetItemFromID(LSEntryID)

Also, you already have the selected item. Why not use it? Like this:

If myOlExp.Selection.Count > 0 Then
Set LastSelected = myOlExp.Selection(1)
End If


--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers

 

[Anita Gupta]

Sue,

Thank you VERY much for helping out on this. I played with this for several
days, of course starting out just using: myOlExp.Selection(1), the problem
is that I need to prompt the user to Journal the item AFTER they've read it.
This means that using the SelectionChange event will prompt the user about
the NEW selection (the one that they HAVEN'T read yet). I use the
LastSelected object to capture and hold the item that was previously
selected (and hence, now just finished being read). I tried it for a long
time just setting LastSelected = myOlExp.Selection(1), however there were
persistent problems with the reference after the myOlExp changed. The only
way I was able to change the value of BillingInformation for the Inbox item
(and keep it changed) was to get the EntryID of the Currently Selected item,
hold it untiil after the Selection Changed and then get the old item by ID
and work with it after the selection changed.

My error does not come about due to no item being selected. My code handles
that just fine. People can switch folders, close Outlook or whatever. The
error comes up if they DELETE the currently selected item before it can be
marked with "J" in the billing information. If a user selects and item and
deletes it before they've switched away from it at least once, the
LastSelected.Save line generates an error because the LastSelected item is
no longer in the Inbox.

Capturing the myOlExp.Selection.Count would have no affect on my code
because I don't care how many items are now selected. I only care about the
previously selected item and am processing that item. I've tried looking at
ItemRemove event however, that event doesn't capture the item. Something
like _ItemRemove(ByVal Item As Object) would be great, but sadly, this event
is a generic _ItemRemove() so I can't reset my LastSelected variable before
it is moved to the Deleted Items folder.

If you run the code, you'll see exactly how it is supposed to function,
processing each item and prompting the user once (and only once) AFTER they
have read the item (either by opening it or by reading it in the Preview
Pane. The only error I'm having now, is if the user deletes the item before
the code has prompted them about Journaling it. That's because it wants to
fire the LastSelected.BillingInformation = "J" -> LastSelected.Save on an
item that's no longer in the inbox.

Any advice is very much appreciated.

I think you probably just need to check the Selection.Count a little more
often to make sure you really have a selected item. Is there a reason why
you're using

LSEntryID = myOlExp.Selection(1).EntryID
Set LastSelected = NS.GetItemFromID(LSEntryID)

Also, you already have the selected item. Why not use it? Like this:

If myOlExp.Selection.Count > 0 Then
Set LastSelected = myOlExp.Selection(1)
End If


--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers

 

[Sue Mosher [MVP]]

I guess I would just trap the error and ignore it, assuming that if the person has deleted the item, they don't want to journal it. Otherwise, you'd need to save something other than the EntryId in order to locate the previous item.

 

[Anita Gupta]

Thanks Sue. I already found a solution that works all the time and prompts
the user (even on delete) in case they forgot to Journal it before deleting.
It works with no errors and allows the user to "un-delete" the item later if
necessary without prompting them again once it gets into the Inbox again. I
already had posted the solution above (see previous posting) as a follow-up
posting to this one. I appreciate all your help.

This seems to be a great work-around to the "Public Journal" solutions found
on Slipstick. That's what I'm using it for. I couldn't put custom code in
the forms themselves because then the Auto-preview wouldn't work on them.
Here is all the code for prompting the user to Journal all Inbox, Sent and
Journal items to a Public Journal.

The only thing I need now to make it complete is a procedure that will be
called when a contact item is saved for the first time that loops through
all the items in the Public Journal and updates the recipients (without the
Security Guard) for items associated with the Contact. This would enable
viewing of all activities associated with the contact (even emails sent and
received before the contact was created). Right now, when you click on an
activities tab and view the public journal, only emails sent to the Journal
after the contact item was created are associated with the contact.

Any interest in giving me some sample code to handle this to be put in a
custom contact form or Macro code that could be called by a button (if not
wanting to use custom forms) when a new contact is created to update
recipeint links?

Here's the whole VBA code. This uses no custom forms and prompts the user to
journal any email items (journal items are moved automatically, they could
be copied instead just as easily.) The code could be easily modified to
auto-journal all items instead of prompting.

Copy and paste the code below into ThisOutlookSession (Be sure to create a
folder called "Public Journal" under the "All Public Folders" directory
first):

Dim LastSelected As MailItem
Dim NewDeleted As Object

Public WithEvents myOlJournal As Outlook.Items
Public WithEvents myOlSentItems As Outlook.Items
Public WithEvents myOlInboxItems As Outlook.Items
Public WithEvents myOlDeletedItems As Outlook.Items
Public WithEvents myOlExp As Outlook.Explorer
Public WithEvents myOlApp As Outlook.Application

Private Sub Application_Startup()
Initialize_handler
End Sub

Public Sub Initialize_handler()
Set myOlJournal =
Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderJournal).Items
Set myOlSentItems =
Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items
Set myOlInboxItems =
Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
Set myOlDeletedItems =
Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Items
Set myOlExp = Application.ActiveExplorer
Set myOlApp = Outlook.Application
End Sub

Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim myJournalItem As MailItem
Dim NS As NameSpace
Dim newJournalFolder As MAPIFolder
Dim JournalResponse

If Item.MessageClass = "IPM.Note" Then
JournalResponse = MsgBox("ItemSend: '" & Item.Subject & "'?", vbYesNo,
"Continue")
If JournalResponse = 6 Then
Set NS = Application.GetNamespace("MAPI")
Set newJournalFolder = NS.Folders("Public Folders").Folders("All
Public Folders").Folders("Public Journal")
Set myJournalItem = Item
myJournalItem.Copy
myJournalItem.Move newJournalFolder
End If
End If
Set NS = Nothing
Set newJournalFolder = Nothing
Set myJournalItem = Nothing
End Sub

Private Sub myOlDeletedItems_ItemAdd(ByVal Item As Object)
Item.BillingInformation = "A"
Item.Save
End Sub

Private Sub myOlInboxItems_ItemAdd(ByVal Item As Object)

Dim NS As NameSpace
Dim newJournal As MAPIFolder
Set NS = Application.GetNamespace("MAPI")
Set newJournal = NS.Folders("Public Folders").Folders("All Public
Folders").Folders("Public Journal")
If Item.BillingInformation = "J" Then
Item.Move newJournal
End If
Set NS = Nothing
Set newJournal = Nothing
End Sub


Private Sub myOlJournal_ItemAdd(ByVal Item As Object)
Dim myJournalItem As Outlook.JournalItem
Dim NS As NameSpace
Dim newJournalFolder As MAPIFolder

Set NS = Application.GetNamespace("MAPI")
Set newJournalFolder = NS.Folders("Public Folders").Folders("All Public
Folders").Folders("Public Journal")
Set myJournalItem = Item
myJournalItem.Move newJournalFolder

Set myJournalItem = Nothing
Set myJournalItem = Nothing
Set NS = Nothing
End Sub


Private Sub myOlExp_Close()
Set myOlExp = Nothing
End Sub

Private Sub myOlExp_SelectionChange()

If myOlExp.CurrentFolder.Name = "Inbox" Then
If myOlExp.Selection(1).MessageClass = "IPM.Note" Then
ProcessInbox
End If
End If

End Sub


Sub ProcessInbox()

Dim JournalResponse As Integer
Dim NS As NameSpace
Dim newJournalFolder As MAPIFolder

Set NS = Application.GetNamespace("MAPI")
Set newJournalFolder = NS.Folders("Public Folders").Folders("All Public
Folders").Folders("Public Journal")
Set InboxItems = NS.GetDefaultFolder(olFolderInbox).Items

If LastSelected Is Nothing Then
Set LastSelected = myOlExp.Selection(1)
Else
If Not LastSelected.EntryID = myOlExp.Selection(1).EntryID Then
If Not (LastSelected.BillingInformation = "J" Or
LastSelected.BillingInformation = "A") Then
On Error Resume Next
LastSelected.BillingInformation = "J"
LastSelected.Save
JournalResponse = MsgBox("Would you like to Journal: '" &
LastSelected.Subject & "'?", vbYesNo, "Continue")
If JournalResponse = 6 Then
LastSelected.Copy
Set LastSelected = myOlExp.Selection(1)
Else
Set LastSelected = NS.GetItemFromID(LSEntryID)
LastSelected.BillingInformation = "J"
LastSelected.Save
Set LastSelected = myOlExp.Selection(1)
End If
Else
If NS.GetDefaultFolder(olFolderInbox).Items.Count > 0 Then
Set LastSelected = myOlExp.Selection(1)
End If
End If
End If
End If

End Sub

Thanks!

Anita

I guess I would just trap the error and ignore it, assuming that if the
person has deleted the item, they don't want to journal it. Otherwise, you'd
need to save something other than the EntryId in order to locate the
previous item.

 

[Scott Braiding]

Hi Anita,

Thanks for posting this code. I copied it into ThisOutlookSession but when
I send a message I get the following error:

"Run-time error '-1698429312 (9c40680)':
The items were copied instead of moved because the original items could not
be deleted. The item could not be deleted. It was either moved or already
deleted,
or access was denied"

The message gets copied to the public folder but sits in the outbox without
being sent.

Any ideas on what I have done wrong?

thanks

Scott

 

[Anita Gupta]

Scott,

Sorry for the slow reply. Try inserting the line:

Cancel = False

Just after the line:

If Item.MessageClass = "IPM.Note" Then

(It would be in the myOlApp_ItemSend() subroutine.

Anita

 

[santhosh kumar challa]

Hi Anitha,

I am new user to this and I am trying to find out a solution that you were trying.

Please help me if you got the reply or if you already have it.

I am working to save in a folder the Outlook inbox messages and its attachements at once sequentially when I run the macro.
I am able to copy the attachments but I am not able to copy the message part i.e., .pst file i.e whole body of message that is received.

here is my code:

Sub GetAttachments()



On Error GoTo GetAttachments_err

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String

Dim i As Integer

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0

If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
FileName = "H:\Email Attachments\" & _
Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item

If i > 0 Then
MsgBox "I found " & i & " attached files." _
& vbCrLf & "I have saved them into the H:\Email Attachments." _
& vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If

GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit

End Sub

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

Moreover, If you can also help me how can I directly send to print in printer this files i.e messages and its attachments.

I will be greatful to you if you help me in this situation because I am doing this project from almost one month and still persisting with above problem.

Thanks in advance.

Santhosh.

 

[santhosh kumar challa]

Hi Anitha,

If you know the solution please mail to (e-mail address removed) or (e-mail address removed)

Thanks in advance,

Santhosh.