OVH Cloud OVH Cloud

Mise à jour RdV Outlook par VBA Excel

1 réponse
Avatar
Philippe
Bonjour à tous,

Avec l'aide de bouts de code récupérés sur la toile j'ai pu lister mes
rendez-vous OL dans un fichier Excel.

J'aimerais pouvoir maintenant mettre à jour OL pour certains de ces
enregistrements, mais malheureusement le programme suivant ne semble pas
fonctionner !

Ceci est-il possible et pouvez m'indiquer où puis-je trouver des exemples.

Merci d'avance

Philippe

=========================================================================
Sub DeleteDoublon()

Application.DisplayAlerts = False
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim olFldr As MAPIFolder
Dim olApt As AppointmentItem
Dim Liste As Worksheet

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderCalendar)

Set Liste = Worksheets("Liste")


For Each olApt In olFldr.Items
Chaine = olApt.Subject & olApt.Start & olApt.Duration & olApt.End _
& olApt.Location & Year(olApt.CreationTime) & "-" &
IIf(Month(olApt.CreationTime) < 10, 0, "") _
& Month(olApt.CreationTime) & "-" & Day(olApt.CreationTime)
With Liste.Range("K:K")
Set c = .Find(Chaine, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Offset(0, -1).Value > 1 Then
c.Offset(0, 1) = "D"
olApt.Categories = "Delete"


End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With


Next

Set olApt = Nothing
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
Application.DisplayAlerts = True
End Sub

1 réponse

Avatar
Philippe
Bonsoir,

J'avais juste oublié :

olApt.Save

Philippe


Bonjour à tous,

Avec l'aide de bouts de code récupérés sur la toile j'ai pu lister mes
rendez-vous OL dans un fichier Excel.

J'aimerais pouvoir maintenant mettre à jour OL pour certains de ces
enregistrements, mais malheureusement le programme suivant ne semble pas
fonctionner !

Ceci est-il possible et pouvez m'indiquer où puis-je trouver des exemples.

Merci d'avance

Philippe

======================================================================== > Sub DeleteDoublon()

Application.DisplayAlerts = False
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim olFldr As MAPIFolder
Dim olApt As AppointmentItem
Dim Liste As Worksheet

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderCalendar)

Set Liste = Worksheets("Liste")


For Each olApt In olFldr.Items
Chaine = olApt.Subject & olApt.Start & olApt.Duration & olApt.End _
& olApt.Location & Year(olApt.CreationTime) & "-" &
IIf(Month(olApt.CreationTime) < 10, 0, "") _
& Month(olApt.CreationTime) & "-" & Day(olApt.CreationTime)
With Liste.Range("K:K")
Set c = .Find(Chaine, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Offset(0, -1).Value > 1 Then
c.Offset(0, 1) = "D"
olApt.Categories = "Delete"


End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With


Next

Set olApt = Nothing
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
Application.DisplayAlerts = True
End Sub