Feuille de travail vers MS Office outlook 2003 SP3

[COLOR=blue]Sub[/COLOR] CreationEvenementOutlook()
    [COLOR=blue]Const[/COLOR] AppointmentItem= 1 [COLOR=green]'item de calendrier[/COLOR]
    [COLOR=blue]Static[/COLOR] i
    [COLOR=blue]Dim[/COLOR] objOutlook [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR]
    [COLOR=blue]Dim[/COLOR] objEvent [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR]
    [COLOR=blue]Dim[/COLOR] objNs [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR]
 
    [COLOR=blue]Set[/COLOR] objOutlook = CreateObject([I]"Outlook.Application"[/I])
    [COLOR=blue]Set[/COLOR] objNs = objOutlook.GetNamespace([I]"MAPI"[/I])
    [COLOR=blue]If[/COLOR] objOutlook.ActiveExplorer [COLOR=blue]Is[/COLOR] [COLOR=blue]Nothing[/COLOR] [COLOR=blue]Then[/COLOR]
        objOutlook.Explorers.Add(objNs.GetDefaultFolder(9), 0).Activate
    [COLOR=blue]Else[/COLOR]
        [COLOR=blue]Set[/COLOR] objOutlook.ActiveExplorer.CurrentFolder = objNs.GetDefaultFolder(9)
        [COLOR=green]'décommenter la ligne ci-dessous pour afficher le calendrier[/COLOR]
        [COLOR=green]'objOutlook.ActiveExplorer.Display[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Set[/COLOR] objEvent = objOutlook.CreateItem(AppointmentItem)
    [COLOR=blue]With[/COLOR] objEvent
        .Start = Range([I]"A1"[/I]) + Range([I]"A2"[/I])
        .[COLOR=blue]End[/COLOR] = .Start + TimeValue([I]"00:01:00"[/I]) [COLOR=green]'pour une heure[/COLOR]
        .Subject = Range([I]"A3"[/I]).Text
         'Ligne ci-dessous facultative
        .Body = [I]"mon évènement "[/I] & Format(Now, [I]"dd/mmm/yyyy hh:mm"[/I])
        .Save
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
    [COLOR=blue]Set[/COLOR] objEvent = [COLOR=blue]Nothing[/COLOR]
    [COLOR=blue]Set[/COLOR] objOutlook = [COLOR=blue]Nothing[/COLOR]
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]