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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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
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
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