View Single Post
  #3  
Old May 11th 07, 07:37 PM posted to microsoft.public.outlook.program_vba
MIchael
external usenet poster
 
Posts: 9
Default itemchange event in public (exchange) folder occurs if nothing is changed

Thank you very much for your answer Ken!
No, there is (nearly :-) no other code or anything that can make it fire. I will post everything below.
Is there any possibility to trap what makes the thing run?
ciao
Michael

Dim WithEvents objFolders As Outlook.Folders
Public WithEvents colPubCustomersItems As Outlook.Items
Public WithEvents colJournalItems As Outlook.Items
'Instantiate collection object in objOutlook Startup event
'um eays2sync anzuwerfen bei Änderung im öff Ordner

Public Sub Application_Startup()
Set objFolders = Session.GetDefaultFolder(olFolderInbox).Parent.Fol ders
Dim strFolderPath As String
strFolderPath = "Öffentliche Ordner\Alle Öffentlichen Ordner\Kontakte von AS-DA2"
Set myolapp = CreateObject("Outlook.Application")
Set myNamespace = myolapp.GetNamespace("MAPI")
Set colPubCustomersItems = myNamespace.Folders("Öffentliche Ordner").Folders("Alle Öffentlichen Ordner").Folders("Kontakte von
AS-DA2").Items
Set colCustomersItems = myNamespace.GetDefaultFolder(olFolderContacts).Ite ms
Set colJournalItems = myNamespace.GetDefaultFolder(olFolderJournal).Item s
'Alles sync beim Outlook start
Shell "C:\Programme\Easy2Sync für Outlook\E2S4Outlook.exe /syncallandexit /nosplash /Delayed:10", 0
End Sub

Private Sub colPubCustomersItems_Itemchange(ByVal Item As Object)
Dim objCont As Outlook.ContactItem
Set objCont = Item
Shell "C:\Programme\Easy2Sync für Outlook\E2S4Outlook.exe /syncandexit:kontakte_dirksen /nosplash", 0 'vbnormal
End Sub

Private Sub colJournalItems_Itemchange(ByVal Item As Object)
Dim objJour As Outlook.JournalItem
Set objJour = Item
Shell "C:\Programme\Easy2Sync für Outlook\E2S4Outlook.exe /syncandexit:journal_dirksen /nosplash", 0
End Sub

Sub objFolders_FolderChange(ByVal Folder As Outlook.MAPIFolder)
On Error GoTo ErrorHandler ' Fehlerbehandlung aktivieren.
If Folder.Name = "Kontakte" Then
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
ErrorHandler:
Set objContact = Nothing
Set objContacts = Nothing
Set objContactsFolder = Nothing
Exit Sub
End If
End Sub





"Ken Slovak - [MVP - Outlook]" schrieb im Newsbeitrag ...
That's not normal, I can open items in public folders without firing Item_Change.

Do the items in that folder run any code that changes something when the item is opened? Is there any macro code or other code
that would run on open that would change the item?

--
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 am monitoring a public contacts folder (on an exchange server). Every time a contact is changed a program should be
launched.
But the event occures even when the contact is only opened. Nothing needs to be changed to let the event fire.
Do I need to take an other event?
My code is below
Thank you very much for your help!!!!
Michael

Public WithEvents colPubCustomersItems As Outlook.Items

Public Sub Application_Startup()
Set objFolders = Session.GetDefaultFolder(olFolderInbox).Parent.Fol ders
Dim strFolderPath As String
strFolderPath = "Öffentliche Ordner\Alle Öffentlichen Ordner\Kontakte von AS-DA2"
Set myolapp = CreateObject("Outlook.Application")
Set myNamespace = myolapp.GetNamespace("MAPI")
Set colPubCustomersItems = myNamespace.Folders("Öffentliche Ordner").Folders("Alle Öffentlichen Ordner").Folders("Kontakte von
AS-DA2").Items
End Sub

Private Sub colPubCustomersItems_Itemchange(ByVal Item As Object)
Dim objCont As Outlook.ContactItem
Set objCont = Item
Shell "C:\Programme\prog_to run.exe", 0 'vbnormal
End Sub





Ads