Appointment userproperties disappear

[Wigi]

Hello all,

I am having a hard time working with UserProperties for appointments. The case is as follows. I have an Excel file that links appointments to 3 properties:
- Company
- Project
- Role

I track my hours spent in Outlook: each appointment should then receive a company, project and role. The appointment subject is something that uniquely links to all 3 properties.

This is fine for 90 % of the regular appointments. However, it's possible that I need to change or overwrite 1 or more properties. I can do that in a VBA userform I designed. I update the relevant properties and I'm good.
It's visible in the calendar view.

However, when I close Outlook entirely and I open again my calendar and I open the custom userform, then it appears that the properties are not known anymore. Even though they are clearly visible in the calendar view and they are assigned values.
Hence, if I test in VBA whether the properties exist, I see that they don't... so VBA code will create them. By doing so, the values are overwritten.

There is a 4th property for 'Tracking', meaning that it can hold: C / P / R / CP / CR / PR / CPR. If I overwrite the company, it gets a C, if I overwrite the project, it gets a P, Role is R, and so on.

Does this ring a bell ? Below the most relevant codes I have in place. Thanks a lot for any pointers !

Sub Appointment_Enrich_CPR(oAppt As Outlook.AppointmentItem)

    Dim sCustomer_Company_Data As String
    Dim sqSplit               As Variant
    Dim sUPTSTracking         As String
    Dim sUPTSCompany          As String
    Dim sUPTSProject          As String
    Dim sUPTSRole             As String
    Dim sUP                   As String

    const gsOL_Property_Company as string = "Company (BOM)"
    const gsOL_Property_Project as string = "Project (BOM)"
    const gsOL_Property_Role as string = "Role (BOM)"
    const gsOL_Property_Tracking as string = "Tracking (BOM)"
    const gsUnknown_Info as string = "X"


    sUPTSTracking = fUserProp(oAppt, gsOL_Property_Tracking, "", 0, -1, 0, -1)
    If sUPTSTracking <> "CPR" Then

        sCustomer_Company_Data = fCustomer_Company_Data

        If Len(sCustomer_Company_Data) Then

            sqSplit = Filter(Split(sCustomer_Company_Data, vbCrLf), oAppt.Subject)
            If UBound(sqSplit) > -1 Then

                sUPTSCompany = Split(sqSplit(0), vbTab)(1)
                sUPTSProject = Split(sqSplit(0), vbTab)(2)
                sUPTSRole = Split(sqSplit(0), vbTab)(3)

            End If

            If sUPTSCompany = "" Then sUPTSCompany = gsUnknown_Info
            If sUPTSProject = "" Then sUPTSProject = gsUnknown_Info
            If sUPTSRole = "" Then sUPTSRole = gsUnknown_Info

            If InStr(sUPTSTracking, "C") = 0 Then
                sUP = fUserProp(oAppt, gsOL_Property_Company, sUPTSCompany, -1, -1, 0, -1)
                sUP = fUserProp(oAppt, gsOL_Property_Tracking, "C", -1, -1, 0, -1)
            End If

            If InStr(sUPTSTracking, "P") = 0 Then
                sUP = fUserProp(oAppt, gsOL_Property_Project, sUPTSProject, -1, -1, 0, -1)
                sUP = fUserProp(oAppt, gsOL_Property_Tracking, "P", -1, -1, 0, -1)
            End If

            If InStr(sUPTSTracking, "R") = 0 Then
                sUP = fUserProp(oAppt, gsOL_Property_Role, sUPTSRole, -1, -1, 0, -1)
                sUP = fUserProp(oAppt, gsOL_Property_Tracking, "R", -1, -1, 0, -1)
            End If

        End If

    End If

End Sub

Function fUserProp( _
         oAppt As AppointmentItem, _
         sProp_Name As String, _
         Optional sValue As String = vbNullString, _
         Optional bUpdate_UserProp As Boolean = False, _
         Optional bCreate_UserProp As Boolean = False, _
         Optional bDelete_UserProp As Boolean = False, _
         Optional bSave_Apptmt As Boolean = False) As String

    Dim UserProperty          As Outlook.UserProperty
    Dim bChange_Was_Done      As Boolean
    Dim i                     As Long
    Dim gsOL_Property_Tracking As String

    If oAppt Is Nothing Then
        Exit Function
    End If

    sProp_Name = Trim(sProp_Name)
    If sProp_Name = "" Then
        Exit Function
    End If

    With oAppt
   
        On Error Resume Next
        Set UserProperty = .UserProperties.Find(sProp_Name, True)
        On Error GoTo 0

        If UserProperty Is Nothing Then
            If bCreate_UserProp Then
                Set UserProperty = .UserProperties.Add(sProp_Name, olText, True, 1)
                bChange_Was_Done = True
            Else
                Exit Function
            End If

        Else
            If bDelete_UserProp Then
                For i = 1 To .UserProperties.Count
                    If .UserProperties.Item(i).Name = sProp_Name Then
                        .UserProperties.Remove i
                        Exit For
                    End If
                Next
                If bSave_Apptmt Then .Save
                Exit Function
            End If
        End If

        If bUpdate_UserProp Then
            sValue = Trim(sValue)
            If UserProperty.Value <> sValue Then
                gsOL_Property_Tracking = ufAexisService.tbx_OL_Property_Tracking.Text
                If sProp_Name <> gsOL_Property_Tracking Then
                    UserProperty.Value = sValue
                Else
                    If InStr(sValue, "-") = 0 Then
                        Select Case UserProperty.Value
                        Case ""
                            UserProperty.Value = sValue
                        Case "C"
                            Select Case sValue
                            Case "P": UserProperty.Value = "CP"
                            Case "R": UserProperty.Value = "CR"
                            End Select
                        Case "P"
                            Select Case sValue
                            Case "C": UserProperty.Value = "CP"
                            Case "R": UserProperty.Value = "PR"
                            End Select
                        Case "R"
                            Select Case sValue
                            Case "C": UserProperty.Value = "CR"
                            Case "P": UserProperty.Value = "PR"
                            End Select
                        Case "CP"
                            Select Case sValue
                            Case "R": UserProperty.Value = "CPR"
                            End Select
                        Case "CR"
                            Select Case sValue
                            Case "P": UserProperty.Value = "CPR"
                            End Select
                        Case "PR"
                            Select Case sValue
                            Case "C": UserProperty.Value = "CPR"
                            End Select
                        Case "CPR"
                            'do nothing
                        End Select
                    Else
                        UserProperty.Value = Replace(UserProperty.Value, Replace(sValue, "-", ""), "")
                    End If

                End If
            End If
            bChange_Was_Done = True
        End If

        'return value of the function
        fUserProp = UserProperty.Value

        If bSave_Apptmt Then
            If bChange_Was_Done Then
                On Error Resume Next
                .Save
                On Error GoTo 0
            End If
        End If
    End With

End Function

 

[Diane Poremsky]

So the values are only missing on the events you updated/overwrote?

 

[Wigi]

Hello Diane,

Thank you for replying !

For your information. I created a userform for a timesheets application where I can:
- query the activities between 2 dates (using the .Restrict method)
- several listboxes are filled with the unique Companies, Projects, Roles (and appointment Subjects, the locations, the olBusy constants, whether Recurring or not, ...)
- the listboxes make totals of the hours spent within each of the selections
- invoicing can be done by exporting the data to an Excel file

Everytime I start the userform, the Userform_Initialize will loop over appointments and add the details to the respective listbox entries. The userproperties are read.
When the 'Tracking' property is 'C', it means that I have overwritten the default Company value that comes from the Excel file with mappings.
When the 'Tracking' property is 'PR', it means that I have overwritten the default Project and Role values that come from the Excel file with mappings.
So anytime the Tracking property is not CPR, I should reuse the Excel file to fill out the missing property values and update the userproperties.

Now, for some reason, the routine that checks for CPR does not recognize the Tracking property when I start from scratch and start Outlook. It's as if it does not stick. That's the fUserProp routine I added in the first post.
Therefore, the fUserProp will create the Tracking property and use the Excel file to provide Company, Project, Role. But then it overwrites my 'manual'
additions - even though I can see the 4 properties and their values in the calendar view !

If I re-apply again the custom Role or Company in the userform, I go back to the calendar views, the values are there. If I stop Outlook and start again, they are recognized.

The main problem is that I loose my manual Company, Project, Role selections as they get overwritten with what comes from Excel because UserProperties are not saved / recognized. For example, the TEST value below gets lost after restarting Outlook. Would there be an issue in the fUserProp function code ?

Does this make sense ?

 

[Wigi]

Hello Diane and others,

Does anyone have a clue here ? I haven't been able to find a solution.
It's difficult to create a reproduction package but in case anyone is willing to do a TeamViewer or Webex or Skype, be my guest ! No obligation of course, it's just if someone is as eager as me to find a solution

Thanks a lot,

Wim

 

[hazelmark760]

I also dont have any idea about it.