What do you mean by "drag the end time"?

--
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


"boh" wrote in message
...
Thanks for your answer.

I have added some tests and debug.prints but the main problem remains.

If I open an appointment, change the end-time and click "Save and close"
everything works fine. Always.

If I open the appointment by clicking the appointment, then drag the
end-time and click beside to close, then the ItemChange event will not
fire
every second occasion. I have never seen two consecutive updates missing.

If I open the appointment after a missing update, the correct end-time
shows
up. As I can see, the only missing thing is: the Itemchange event will not
fire!

Any thoughts about what needs to be done here?

Thanks / boh

In the calendar view, I put the cursor on the bottom of the appointment, hold
the left mouse key down and drag the mouse down, say an hour, and then
release the mouse key. Then I move the mouse outside the appointment and
click.

Sorry for my English but I hope you can understand what I mean.
/ boh

"Ken Slovak - [MVP - Outlook]" skrev:

What do you mean by "drag the end time"?

--
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


"boh" wrote in message
...
Thanks for your answer.

I have added some tests and debug.prints but the main problem remains.

If I open an appointment, change the end-time and click "Save and close"
everything works fine. Always.

If I open the appointment by clicking the appointment, then drag the
end-time and click beside to close, then the ItemChange event will not
fire
every second occasion. I have never seen two consecutive updates missing.

If I open the appointment after a missing update, the correct end-time
shows
up. As I can see, the only missing thing is: the Itemchange event will not
fire!

Any thoughts about what needs to be done here?

Thanks / boh

I'm sorry, but I can't repro that here. If I drag an appointment's end time
using the mouse in an Explorer view then as soon as the focus moves to a
different item or the changed appointment isn't selected for in-cell editing
the change is committed and I get an ItemChange 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


"boh" wrote in message
...
In the calendar view, I put the cursor on the bottom of the appointment,
hold
the left mouse key down and drag the mouse down, say an hour, and then
release the mouse key. Then I move the mouse outside the appointment and
click.

Sorry for my English but I hope you can understand what I mean.
/ boh

If I disable my macro, everything works OK. But when I enable the following
code, the problem starts. In other words: I'm doing something wrong in my
macro.
/boh

Option Explicit
Public TocFolder As Outlook.MAPIFolder
Public WithEvents CalendarItems As Outlook.Items
Public WithEvents DeletedItems As Outlook.Items
Public sUser As String

Public Sub Initialize_handler()
sUser = "BOH "
Set CalendarItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderCalendar).Items
Set DeletedItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems).Items
' Path to public folder
Set TocFolder = GetFolder("Public Folders\All Public Folders\......TOC")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
End If
End Sub

Private Sub Application_Startup()
Initialize_handler
End Sub

Private Sub DeletedItems_Itemadd(ByVal Item As Object)
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OStr As String
On Error Resume Next
'MsgBox ("ItemDel")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
ElseIf Item.Class = olAppointment Then
OStr = "[Item]='" & Item & "'"
'MsgBox OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
End If
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemadd(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim myStr As String
On Error Resume Next
'MsgBox ("ItemAdd")
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Item.BillingInformation = Item.LastModificationTime
If Err.Number 0 Then GoTo Out
Item.Save
Debug.Print "ItemAdd [Item) = " & Item
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
Call App1(Item)
End If
End If
Out:
Set myAppt = Nothing
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemchange(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OPalmFolder As Outlook.MAPIFolder
Dim OStr As String
On Error Resume Next
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Debug.Print "ItemChange Item = " & Item
If Err.Number 0 Then GoTo Out
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
'OStr = "[Item]='" & Item & "'"
'MsgBox OStr
'Debug.Print OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
Call App1(Item)
End If
Set myAppt = Nothing
Else
' Debug.Print Item.Class
End If
Out:
Debug.Print "ItemChange out "
Set myAppt = Nothing
Set OPalmFolder = Nothing
Set OCalItem = Nothing
End Sub

Sub App1(ByVal Item)
Dim myAppt As Outlook.AppointmentItem
'Set myAppt = TocFolder.Items.Add(Outlook.OlItemType.olAppointme ntItem)

If Item.Duration = 240 Then
Set myAppt = Item.Copy
If myAppt.Sensitivity olPrivate Then
myAppt.Subject = sUser & Item.Subject
Else
myAppt.Subject = sUser & "Privat"
myAppt.Location = ""
End If
myAppt.ReminderSet = False
myAppt.Save
myAppt.Move TocFolder
End If
Set myAppt = Nothing
End Sub


Function GetFolder(FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim strFolderPath
Dim fldr As MAPIFolder
Dim i
Dim objNS

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")

'get the Outlook objects
' use intrinsic Application object in form script
Set objNS = Application.GetNamespace("MAPI")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err 0 Then Exit Function
Next
Set GetFolder = fldr

' dereference objects
Set objNS = Nothing
End Function

"Ken Slovak - [MVP - Outlook]" skrev:

I'm sorry, but I can't repro that here. If I drag an appointment's end time
using the mouse in an Explorer view then as soon as the focus moves to a
different item or the changed appointment isn't selected for in-cell editing
the change is committed and I get an ItemChange 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


"boh" wrote in message
...
In the calendar view, I put the cursor on the bottom of the appointment,
hold
the left mouse key down and drag the mouse down, say an hour, and then
release the mouse key. Then I move the mouse outside the appointment and
click.

Sorry for my English but I hope you can understand what I mean.
/ boh

Your logic is causing a loop of ItemAdd and ItemChange events to fire within
the existing event handlers. That's a very good reason to miss some events,
especially because you're trying to force a failure by doing changes very
quickly and using code that takes a little time within the event handlers.

A general rule of thumb for coding microprocessors is not to force one
interrupt service routine to take too long or to force another or the same
interrupt service routine to fire itself. It's a formula for missing things.

Either store the EntryID and StoreID of the items to move/copy within the
event handler and set a timer to fire a couple of seconds later to pick up
the item or items, or use a different API such as CDO 1.21 or Redemption to
have a CopyTo method that doesn't copy the original item to the same folder.

--
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


"boh" wrote in message
...
If I disable my macro, everything works OK. But when I enable the
following
code, the problem starts. In other words: I'm doing something wrong in my
macro.
/boh

Option Explicit
Public TocFolder As Outlook.MAPIFolder
Public WithEvents CalendarItems As Outlook.Items
Public WithEvents DeletedItems As Outlook.Items
Public sUser As String

Public Sub Initialize_handler()
sUser = "BOH "
Set CalendarItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderCalendar).Items
Set DeletedItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems).Items
' Path to public folder
Set TocFolder = GetFolder("Public Folders\All Public Folders\......TOC")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
End If
End Sub

Private Sub Application_Startup()
Initialize_handler
End Sub

Private Sub DeletedItems_Itemadd(ByVal Item As Object)
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OStr As String
On Error Resume Next
'MsgBox ("ItemDel")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
ElseIf Item.Class = olAppointment Then
OStr = "[Item]='" & Item & "'"
'MsgBox OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
End If
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemadd(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim myStr As String
On Error Resume Next
'MsgBox ("ItemAdd")
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Item.BillingInformation = Item.LastModificationTime
If Err.Number 0 Then GoTo Out
Item.Save
Debug.Print "ItemAdd [Item) = " & Item
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
Call App1(Item)
End If
End If
Out:
Set myAppt = Nothing
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemchange(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OPalmFolder As Outlook.MAPIFolder
Dim OStr As String
On Error Resume Next
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Debug.Print "ItemChange Item = " & Item
If Err.Number 0 Then GoTo Out
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
'OStr = "[Item]='" & Item & "'"
'MsgBox OStr
'Debug.Print OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
Call App1(Item)
End If
Set myAppt = Nothing
Else
' Debug.Print Item.Class
End If
Out:
Debug.Print "ItemChange out "
Set myAppt = Nothing
Set OPalmFolder = Nothing
Set OCalItem = Nothing
End Sub

Sub App1(ByVal Item)
Dim myAppt As Outlook.AppointmentItem
'Set myAppt = TocFolder.Items.Add(Outlook.OlItemType.olAppointme ntItem)

If Item.Duration = 240 Then
Set myAppt = Item.Copy
If myAppt.Sensitivity olPrivate Then
myAppt.Subject = sUser & Item.Subject
Else
myAppt.Subject = sUser & "Privat"
myAppt.Location = ""
End If
myAppt.ReminderSet = False
myAppt.Save
myAppt.Move TocFolder
End If
Set myAppt = Nothing
End Sub


Function GetFolder(FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim strFolderPath
Dim fldr As MAPIFolder
Dim i
Dim objNS

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")

'get the Outlook objects
' use intrinsic Application object in form script
Set objNS = Application.GetNamespace("MAPI")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err 0 Then Exit Function
Next
Set GetFolder = fldr

' dereference objects
Set objNS = Nothing
End Function

Thank you very much / boh

"Ken Slovak - [MVP - Outlook]" skrev:

Your logic is causing a loop of ItemAdd and ItemChange events to fire within
the existing event handlers. That's a very good reason to miss some events,
especially because you're trying to force a failure by doing changes very
quickly and using code that takes a little time within the event handlers.

A general rule of thumb for coding microprocessors is not to force one
interrupt service routine to take too long or to force another or the same
interrupt service routine to fire itself. It's a formula for missing things.

Either store the EntryID and StoreID of the items to move/copy within the
event handler and set a timer to fire a couple of seconds later to pick up
the item or items, or use a different API such as CDO 1.21 or Redemption to
have a CopyTo method that doesn't copy the original item to the same folder.

--
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


"boh" wrote in message
...
If I disable my macro, everything works OK. But when I enable the
following
code, the problem starts. In other words: I'm doing something wrong in my
macro.
/boh

Option Explicit
Public TocFolder As Outlook.MAPIFolder
Public WithEvents CalendarItems As Outlook.Items
Public WithEvents DeletedItems As Outlook.Items
Public sUser As String

Public Sub Initialize_handler()
sUser = "BOH "
Set CalendarItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderCalendar).Items
Set DeletedItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems).Items
' Path to public folder
Set TocFolder = GetFolder("Public Folders\All Public Folders\......TOC")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
End If
End Sub

Private Sub Application_Startup()
Initialize_handler
End Sub

Private Sub DeletedItems_Itemadd(ByVal Item As Object)
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OStr As String
On Error Resume Next
'MsgBox ("ItemDel")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
ElseIf Item.Class = olAppointment Then
OStr = "[Item]='" & Item & "'"
'MsgBox OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
End If
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemadd(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim myStr As String
On Error Resume Next
'MsgBox ("ItemAdd")
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Item.BillingInformation = Item.LastModificationTime
If Err.Number 0 Then GoTo Out
Item.Save
Debug.Print "ItemAdd [Item) = " & Item
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
Call App1(Item)
End If
End If
Out:
Set myAppt = Nothing
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemchange(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OPalmFolder As Outlook.MAPIFolder
Dim OStr As String
On Error Resume Next
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Debug.Print "ItemChange Item = " & Item
If Err.Number 0 Then GoTo Out
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
'OStr = "[Item]='" & Item & "'"
'MsgBox OStr
'Debug.Print OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
Call App1(Item)
End If
Set myAppt = Nothing
Else
' Debug.Print Item.Class
End If
Out:
Debug.Print "ItemChange out "
Set myAppt = Nothing
Set OPalmFolder = Nothing
Set OCalItem = Nothing
End Sub

Sub App1(ByVal Item)
Dim myAppt As Outlook.AppointmentItem
'Set myAppt = TocFolder.Items.Add(Outlook.OlItemType.olAppointme ntItem)

If Item.Duration = 240 Then
Set myAppt = Item.Copy
If myAppt.Sensitivity olPrivate Then
myAppt.Subject = sUser & Item.Subject
Else
myAppt.Subject = sUser & "Privat"
myAppt.Location = ""
End If
myAppt.ReminderSet = False
myAppt.Save
myAppt.Move TocFolder
End If
Set myAppt = Nothing
End Sub


Function GetFolder(FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim strFolderPath
Dim fldr As MAPIFolder
Dim i
Dim objNS

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")

'get the Outlook objects
' use intrinsic Application object in form script
Set objNS = Application.GetNamespace("MAPI")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err 0 Then Exit Function
Next
Set GetFolder = fldr

' dereference objects
Set objNS = Nothing
End Function

Hi again!

I have included CDO in Outlook but I can't get copyto working. Please, do
you have a piece of code showing how to copy the Item object, parameter to
Itemchange event, to public folder? Thanks / boh

"boh" skrev:

Thank you very much / boh

"Ken Slovak - [MVP - Outlook]" skrev:

Your logic is causing a loop of ItemAdd and ItemChange events to fire within
the existing event handlers. That's a very good reason to miss some events,
especially because you're trying to force a failure by doing changes very
quickly and using code that takes a little time within the event handlers.

A general rule of thumb for coding microprocessors is not to force one
interrupt service routine to take too long or to force another or the same
interrupt service routine to fire itself. It's a formula for missing things.

Either store the EntryID and StoreID of the items to move/copy within the
event handler and set a timer to fire a couple of seconds later to pick up
the item or items, or use a different API such as CDO 1.21 or Redemption to
have a CopyTo method that doesn't copy the original item to the same folder.

--
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


"boh" wrote in message
...
If I disable my macro, everything works OK. But when I enable the
following
code, the problem starts. In other words: I'm doing something wrong in my
macro.
/boh

Option Explicit
Public TocFolder As Outlook.MAPIFolder
Public WithEvents CalendarItems As Outlook.Items
Public WithEvents DeletedItems As Outlook.Items
Public sUser As String

Public Sub Initialize_handler()
sUser = "BOH "
Set CalendarItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderCalendar).Items
Set DeletedItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems).Items
' Path to public folder
Set TocFolder = GetFolder("Public Folders\All Public Folders\......TOC")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
End If
End Sub

Private Sub Application_Startup()
Initialize_handler
End Sub

Private Sub DeletedItems_Itemadd(ByVal Item As Object)
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OStr As String
On Error Resume Next
'MsgBox ("ItemDel")
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
ElseIf Item.Class = olAppointment Then
OStr = "[Item]='" & Item & "'"
'MsgBox OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
End If
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemadd(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim myStr As String
On Error Resume Next
'MsgBox ("ItemAdd")
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Item.BillingInformation = Item.LastModificationTime
If Err.Number 0 Then GoTo Out
Item.Save
Debug.Print "ItemAdd [Item) = " & Item
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
Call App1(Item)
End If
End If
Out:
Set myAppt = Nothing
Set OCalItem = Nothing
End Sub

Private Sub CalendarItems_Itemchange(ByVal Item As Object)
Dim myAppt As Outlook.AppointmentItem
Dim OCalItem As Outlook.AppointmentItem
Dim PalmFolder As Outlook.Folders
Dim OPalmFolder As Outlook.MAPIFolder
Dim OStr As String
On Error Resume Next
'If Flag Then GoTo Out
If Item.Class = olAppointment Then
Err.Clear
Debug.Print "ItemChange Item = " & Item
If Err.Number 0 Then GoTo Out
If TocFolder Is Nothing Then
MsgBox "Can´t get the folder TOC"
Else
'OStr = "[Item]='" & Item & "'"
'MsgBox OStr
'Debug.Print OStr
Set OCalItem = TocFolder.Items.Find("[BillingInformation]='" &
Item.BillingInformation & "'")
If TypeName(OCalItem) "Nothing" Then
OCalItem.Delete
End If
Call App1(Item)
End If
Set myAppt = Nothing
Else
' Debug.Print Item.Class
End If
Out:
Debug.Print "ItemChange out "
Set myAppt = Nothing
Set OPalmFolder = Nothing
Set OCalItem = Nothing
End Sub

Sub App1(ByVal Item)
Dim myAppt As Outlook.AppointmentItem
'Set myAppt = TocFolder.Items.Add(Outlook.OlItemType.olAppointme ntItem)

If Item.Duration = 240 Then
Set myAppt = Item.Copy
If myAppt.Sensitivity olPrivate Then
myAppt.Subject = sUser & Item.Subject
Else
myAppt.Subject = sUser & "Privat"
myAppt.Location = ""
End If
myAppt.ReminderSet = False
myAppt.Save
myAppt.Move TocFolder
End If
Set myAppt = Nothing
End Sub


Function GetFolder(FolderPath)
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim aFolders
Dim strFolderPath
Dim fldr As MAPIFolder
Dim i
Dim objNS

On Error Resume Next
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")

'get the Outlook objects
' use intrinsic Application object in form script
Set objNS = Application.GetNamespace("MAPI")

'set the root folder
Set fldr = objNS.Folders(aFolders(0))

'loop through the array to get the subfolder
'loop is skipped when there is only one element in the array
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err 0 Then Exit Function
Next
Set GetFolder = fldr

' dereference objects
Set objNS = Nothing
End Function

Show the code you're using.

For CopyTo to a different store you need to include the StoreID argument.

--
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


"boh" wrote in message
...
Hi again!

I have included CDO in Outlook but I can't get copyto working. Please, do
you have a piece of code showing how to copy the Item object, parameter to
Itemchange event, to public folder? Thanks / boh

"boh" skrev:

Thank you very much / boh

Here is the code I'm using.
The "Set myAppt = .." statement gives an error:
Run-time error '438':
Object dosen't support this property or method

Sub App1(ByVal Item)
Dim myAppt As Outlook.AppointmentItem
Dim cdoSession As MAPI.Session
Dim sStoreID As String
Dim sEntryID As String
Set cdoSession = CreateObject("MAPI.Session")
cdoSession.Logon "", "", False, False
sEntryID = TocFolder.EntryID
sStoreID = TocFolder.StoreID
Set myAppt = Item.CopyTo(sEntryID, sStoreID)
myAppt.Update True
Debug.Print "myApp.BillingInformation = " & myAppt.BillingInformation
Set myAppt = Nothing
End Sub

/boh

"Ken Slovak - [MVP - Outlook]" skrev:

Show the code you're using.

For CopyTo to a different store you need to include the StoreID argument.

--
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


"boh" wrote in message
...
Hi again!

I have included CDO in Outlook but I can't get copyto working. Please, do
you have a piece of code showing how to copy the Item object, parameter to
Itemchange event, to public folder? Thanks / boh

"boh" skrev:

Thank you very much / boh

That code is trying to set an Outlook item using a CDO method, which will
never work. You cannot declare an Outlook.AppointmentItem and try to use CDO
methods such as CopyTo and Update on it. Nor can you set a CDO
AppointmentItem when you create anything in a folder that isn't the default
Calendar folder for that logon.

What is Item? Is it a CDO Message or an Outlook object?

Where is TocFolder set? Is that global so it's accessible from the
procedure?

I'd spend some time reviewing the code samples for CDO at
www.cdolive.com/cdo5.htm to see how to do some very basic CDO operations.

--
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


"boh" wrote in message
...
Here is the code I'm using.
The "Set myAppt = .." statement gives an error:
Run-time error '438':
Object dosen't support this property or method

Sub App1(ByVal Item)
Dim myAppt As Outlook.AppointmentItem
Dim cdoSession As MAPI.Session
Dim sStoreID As String
Dim sEntryID As String
Set cdoSession = CreateObject("MAPI.Session")
cdoSession.Logon "", "", False, False
sEntryID = TocFolder.EntryID
sStoreID = TocFolder.StoreID
Set myAppt = Item.CopyTo(sEntryID, sStoreID)
myAppt.Update True
Debug.Print "myApp.BillingInformation = " & myAppt.BillingInformation
Set myAppt = Nothing
End Sub

/boh

"Ken Slovak - [MVP - Outlook]" skrev:

Show the code you're using.

For CopyTo to a different store you need to include the StoreID argument.

--
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


"boh" wrote in message
...
Hi again!

I have included CDO in Outlook but I can't get copyto working. Please,
do
you have a piece of code showing how to copy the Item object, parameter
to
Itemchange event, to public folder? Thanks / boh

"boh" skrev:

Thank you very much / boh