this code will not work with previous versions of outlook as the label colour was added in outlook 2002.

 

local looutlook   as outlook.application

local lonamespace as outlook.namespace

local loappoint   as outlook.appointmentitem

 

looutlook   = createobject('outlook.application')

lonamespace = looutlook.getnamespace("mapi")

lonamespace.logon

loappoint   = looutlook.createitem( 1 )     && olappointmentitem

 

with loappoint as outlook.appointmentitem

    .subject = "test for change of label colour"

    .start   = datetime() + (60 * 60)    && add an hour.

    .save      && need to save for entryid, this is then used to change the label.

    =setappointmentlabelcolour( loappoint, 6) && 0 = none, 1 to 10

endwith

 

loappoint   = .null.

lonamespace = .null.

looutlook   = .null.

 

 

procedure setappointmentlabelcolour( toapp   as outlook.appointmentitem, ;

                                     tncolor as integer )

    *-- original vba code by sue mosher, converted to vfp by s.arnold.

    *-- requires cdo 1.21

    local lccdopropsetid1 as string, lccdoappt_color as string

    local locdo    as mapi.session

    local lomsg    as mapi.message

    local lofields as mapi.fields

    local lofield  as mapi.field

    local lcmsg    as string

 

    lccdopropsetid1  = "0220060000000000c000000000000046"

    lccdoappt_colors = "0x8214"

 

    locdo = createobject('mapi.session')

    locdo.logon(,,.f.,.f.)

    if !empty(toapp.entryid)

        lomsg    = locdo.getmessage(toapp.entryid,toapp.parent.storeid)

        lofields = lomsg.fields

        lofield  = lofields.item(lccdoappt_colors,lccdopropsetid1)

        if isnull(lofield)

            && the 3 in the parameters represents vblong type.

            lofield = lofields.add(lccdoappt_colors,3,tncolor,lccdopropsetid1)

        else

            lofield.value = tncolor

        endif

        lomsg.update(.t.,.t.)

    else

        lcmsg = "you must save the appointment before you add a color label. " + ;

                "do you want to save the appointment now?"

        if messagebox(lcmsg,36,"set appointment color label") = 6

            =setappcolorlabel(toapp,tncolor)

        endif

    endif

    lomsg    = .null.

    lofields = .null.

    lofield  = .null.

    locdo.logoff

    locdo = .null.

endproc

 

Leave a Reply

Your email address will not be published. Required fields are marked *