Hello
I have the following code for automatic journalling of new contacts.
THat means when the save button for a contact is pressed it should be
registered for jounalling
The new entry for journalling is generated if I run that part of the code
separately. But if I close the contact nothing happens. WHeres the error in
my code (code is in "DieseOutlookSitzung")
:-) careful Im beginner :-)
Thank you very much for help!!!
MIchael


Public WithEvents myItem As Outlook.ContactItem
'--------------------------------------------------------

Public Sub Initalize_Handler()
Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Set myItem = Application.ActiveInspector.CurrentItem
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub
'--------------------------------------------------------

Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub

I don't see anywhere in your code where you are initializing the myItem
object unless the Initalize_Handler procedure is manually executed. What you
need is a handler that inits that item when a new item is opened. That is
the NewInspector event of the Inspectors collection.

Dim WithEvents colInspectors As Outlook.Inspectors

Then in your initialization code you should instantiate that collection:

Set colInspectors = Application.Inspectors

The NewInspector event handler would look something like this:

Private Sub NewInspector(Inspector As Inspector)
If Inspector.CurrentItem.Class = olContact Then
Set myItem = Inspector.CurrentItem
End If
End Sub

That tests for a contact item and instantiates myItem so it will handle the
Write event. You might also want to handle the Close event possibly.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"MIchael" wrote in message
...
Hello
I have the following code for automatic journalling of new contacts.
THat means when the save button for a contact is pressed it should be
registered for jounalling
The new entry for journalling is generated if I run that part of the code
separately. But if I close the contact nothing happens. WHeres the error
in my code (code is in "DieseOutlookSitzung")
:-) careful Im beginner :-)
Thank you very much for help!!!
MIchael


Public WithEvents myItem As Outlook.ContactItem
'--------------------------------------------------------

Public Sub Initalize_Handler()
Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Set myItem = Application.ActiveInspector.CurrentItem
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub
'--------------------------------------------------------

Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub

Hello Ken
thanks for your help!
You are right the Initalize_Handler is not manually executed.
but sorry Im too new to understand what you say.
I altered the code in that way but nothing happens. Could you please give me
some further advice??
Thanks
MIchael


Public WithEvents myItem As Outlook.ContactItem

Private Sub NewInspector(Inspector As Inspector)
If Inspector.CurrentItem.Class = olContact Then
Set myItem = Inspector.CurrentItem
End If
End Sub

Public Sub Initalize_Handler()
Dim WithEvents colInspectors As Outlook.Inspectors
Set colInspectors = Application.Inspectors

Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Set myItem = Application.ActiveInspector.CurrentItem
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub


Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub




"Ken Slovak - [MVP - Outlook]" schrieb im Newsbeitrag
...
I don't see anywhere in your code where you are initializing the myItem
object unless the Initalize_Handler procedure is manually executed. What
you need is a handler that inits that item when a new item is opened. That
is the NewInspector event of the Inspectors collection.

Dim WithEvents colInspectors As Outlook.Inspectors

Then in your initialization code you should instantiate that collection:

Set colInspectors = Application.Inspectors

The NewInspector event handler would look something like this:

Private Sub NewInspector(Inspector As Inspector)
If Inspector.CurrentItem.Class = olContact Then
Set myItem = Inspector.CurrentItem
End If
End Sub

That tests for a contact item and instantiates myItem so it will handle
the Write event. You might also want to handle the Close event possibly.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"MIchael" wrote in message
...
Hello
I have the following code for automatic journalling of new contacts.
THat means when the save button for a contact is pressed it should be
registered for jounalling
The new entry for journalling is generated if I run that part of the code
separately. But if I close the contact nothing happens. WHeres the error
in my code (code is in "DieseOutlookSitzung")
:-) careful Im beginner :-)
Thank you very much for help!!!
MIchael


Public WithEvents myItem As Outlook.ContactItem
'--------------------------------------------------------

Public Sub Initalize_Handler()
Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Set myItem = Application.ActiveInspector.CurrentItem
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub
'--------------------------------------------------------

Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub

A WithEvents declaration must be made outside of any procedures. If you want
the code to run automatically it must go in Application_Startup() in
ThisOutlookSession. Otherwise you must run it manually in a macro:

Dim WithEvents myItem As Outlook.ContactItem
Dim WithEvents colInspectors As Outlook.Inspectors

Private Sub NewInspector(Inspector As Inspector)
If Inspector.CurrentItem.Class = olContact Then
Set myItem = Inspector.CurrentItem
End If
End Sub

Public Sub Application_Startup()
Set colInspectors = Application.Inspectors

Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub


Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"MIchael" wrote in message
...
Hello Ken
thanks for your help!
You are right the Initalize_Handler is not manually executed.
but sorry Im too new to understand what you say.
I altered the code in that way but nothing happens. Could you please give
me some further advice??
Thanks
MIchael


Public WithEvents myItem As Outlook.ContactItem

Private Sub NewInspector(Inspector As Inspector)
If Inspector.CurrentItem.Class = olContact Then
Set myItem = Inspector.CurrentItem
End If
End Sub

Public Sub Initalize_Handler()
Dim WithEvents colInspectors As Outlook.Inspectors
Set colInspectors = Application.Inspectors

Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Set myItem = Application.ActiveInspector.CurrentItem
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub


Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub

Thank you very much Ken
in the meanwhile I managed it :-))

But one (hopefully last) question:
I run my code on the write event. But I see that my code does not get any
new item because the item is not yet saved.
So I have to trap an event thats after the write event and after the item
has been added to the collection.
can you tell me what event to use?
Thanks!
ciao
Michael


Public WithEvents colInsp As Outlook.Inspectors
Public WithEvents objContactItem As Outlook.ContactItem

Private Sub Application_Startup()
Set colInsp = Application.Inspectors
End Sub

Private Sub colInsp_NewInspector(ByVal Inspector As Inspector)
Dim objItem As Object
Set objInsp = Inspector
On Error Resume Next
Set objItem = objInsp.CurrentItem
Select Case objItem.Class
Case olContact
Set objContactItem = objItem
End Select
End Sub

Private Sub objContactItem_write(Cancel As Boolean)
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub
End Sub





"Ken Slovak - [MVP - Outlook]" schrieb im Newsbeitrag
...
A WithEvents declaration must be made outside of any procedures. If you
want the code to run automatically it must go in Application_Startup() in
ThisOutlookSession. Otherwise you must run it manually in a macro:

Dim WithEvents myItem As Outlook.ContactItem
Dim WithEvents colInspectors As Outlook.Inspectors

Private Sub NewInspector(Inspector As Inspector)
If Inspector.CurrentItem.Class = olContact Then
Set myItem = Inspector.CurrentItem
End If
End Sub

Public Sub Application_Startup()
Set colInspectors = Application.Inspectors

Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub


Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"MIchael" wrote in message
...
Hello Ken
thanks for your help!
You are right the Initalize_Handler is not manually executed.
but sorry Im too new to understand what you say.
I altered the code in that way but nothing happens. Could you please give
me some further advice??
Thanks
MIchael


Public WithEvents myItem As Outlook.ContactItem

Private Sub NewInspector(Inspector As Inspector)
If Inspector.CurrentItem.Class = olContact Then
Set myItem = Inspector.CurrentItem
End If
End Sub

Public Sub Initalize_Handler()
Dim WithEvents colInspectors As Outlook.Inspectors
Set colInspectors = Application.Inspectors

Const strCancelEvent = "Application-defined or object-defined error"

On Error GoTo ErrHandler

Set myItem = Application.ActiveInspector.CurrentItem
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If


End Sub


Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "soll dieser Kontakt im Journal geloggt werden?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub

Write only fires when an item is saved. It's the Saved event really.

If no save is ever made eventually the item is not persisted and does not
become part of the collection when it's released.

The PropertyChange event will fire for most changes to an item, telling you
what property was changed. However, it fires a lot and setting just one
property such as FullName in a contact will result in firing that event many
times (as an example).

You can use the Close event, which will fire when the item is finally
closed. You can then check the Saved status to see if the item was persisted
or discarded in that event.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"MIchael" wrote in message
...
Thank you very much Ken
in the meanwhile I managed it :-))

But one (hopefully last) question:
I run my code on the write event. But I see that my code does not get any
new item because the item is not yet saved.
So I have to trap an event thats after the write event and after the item
has been added to the collection.
can you tell me what event to use?
Thanks!
ciao
Michael


Public WithEvents colInsp As Outlook.Inspectors
Public WithEvents objContactItem As Outlook.ContactItem

Private Sub Application_Startup()
Set colInsp = Application.Inspectors
End Sub

Private Sub colInsp_NewInspector(ByVal Inspector As Inspector)
Dim objItem As Object
Set objInsp = Inspector
On Error Resume Next
Set objItem = objInsp.CurrentItem
Select Case objItem.Class
Case olContact
Set objContactItem = objItem
End Select
End Sub

Private Sub objContactItem_write(Cancel As Boolean)
Dim objContactsFolder As Outlook.MAPIFolder
Dim objContacts As Outlook.Items
Dim objContact As Object
Dim iCount As Integer

' Zu verwendenden Kontaktordner angeben
Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

iCount = 0

' Änderungen verarbeiten
For Each objContact In objContacts
If TypeName(objContact) = "ContactItem" Then
If objContact.Journal = False Then
objContact.Journal = True
objContact.Save
iCount = iCount + 1
End If
End If
Next

MsgBox "Anzahl aktualisierter Kontakte:" & Str$(iCount)

' Aufräumen
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub
End Sub