Rendez-vous Outlook via Excel

[asfour]

Bonjour,

j'ai une macro qui crée le rendez-vous a partir d'un tableau excel et qui fonctionne très bien mais le problème a chaque fois que la macro et exécuté il recrée les mêmes rendez-vous ce qui fait que j'ai plusieurs fois le même rendez-vous

je ne c'est pas si il y a moyen de crée une condition qui règle le problème.

je vous la macro que j'ai:

Sub NouveauRDV_Calendrier()
'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
Dim myOlApp As New Outlook.Application
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range

For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
Set MyItem = myOlApp.CreateItem(olAppointmentItem)


With MyItem
.MeetingStatus = olNonMeeting
.Subject = Cell
.Start = Cell.Offset(0, 1)
.Duration = Cell.Offset(0, 2) 'minutes
.Location = Cell.Offset(0, 3)
.Body = Cell.Offset(0, 4)
.Save
End With

Set MyItem = Nothing
Next Cell

End Sub


Merci pour votre aide

 

[pyfux]

Re : Rendez-vous Outlook via Excel

Bonjour,

Avant la ligne:

Set MyItem = myOlApp.CreateItem(olAppointmentItem)

Il faut vérifier si le rendez-vous existe. (sur quel critère?...)
Si non, faire la création.
Si oui, faire la MAJ. Quel est la règle de synchronisation?

 

[Guest]

Re : Rendez-vous Outlook via Excel

Bonjour,

Ajoute une colonne à ton fichier qui contiendra 1 lorsque la macro aura créée le rendez-vous, dans l'exemple ci-dessous, colonne k (10ème colonne à droite de A), au lancement suivant si la colonne ne contient pas 1 alors le rendez-vous sera créé sinon la macro passera au suivant sans création.

    For Each cell In Range("A8:A" & Range("A22").End(xlUp).Row)
        If cell.Offset(, 10) <> 1 Then    ' colonne K
            Set MyItem = myOlApp.CreateItem(olAppointmentItem)
            With MyItem
                .MeetingStatus = olNonMeeting
                .Subject = cell
                .Start = cell.Offset(0, 1)
                .Duration = cell.Offset(0, 2)    'minutes
                .Location = cell.Offset(0, 3)
                .Body = cell.Offset(0, 4)
                .Save
                .cell.Offset(, 10) = 1
            End With
            Set MyItem = Nothing
        End If
    Next cell

A+

 

[asfour]

Re : Rendez-vous Outlook via Excel

Bonjour,
Merci pour votre aide,

j'ai teste le code que tu m'a donnée mais il me met une erreure a cette ligne:

.cell.Offset(, 10) = 1

je ne c'est pas pourquoi, donc mon code est:

Sub NouveauRDV_Calendrier()
'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
Dim myOlApp As New Outlook.Application
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range



For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
If Cell.Offset(,10) <> 1 Then ' colonne K
Set MyItem = myOlApp.CreateItem(olAppointmentItem)

With MyItem
.MeetingStatus = olNonMeeting
.Subject = Cell
.Start = Cell.Offset(0, 1)
.Duration = Cell.Offset(0, 2) 'minutes
.Location = Cell.Offset(0, 3)
.Body = Cell.Offset(0, 4)
.Save
.Cell.Offset(, 10) = 1
End With

Set MyItem = Nothing
End If
Next Cell

End Sub

 

[JCGL]

Re : Rendez-vous Outlook via Excel

Bonjour à tous,
Salut mon Ges,

AsFour : Enlève le point devant .Cell.Offset(, 10) = 1

A+++ mon Ges
A+ à tous

 

[asfour]

Re : Rendez-vous Outlook via Excel

Bonjour JCGL

Merci pour ton aide.

j'ai essaye mes il me donne l'erreur: Sub ou Fonction non définie

 

[JCGL]

Re : Rendez-vous Outlook via Excel

Bonjour à tous,

Euh...
Le premier point :

With MyItem .MeetingStatus = olNonMeeting
.Subject = Cell
.Start = Cell.Offset(0, 1)
.Duration = Cell.Offset(0, 2) 'minutes
.Location = Cell.Offset(0, 3)
.Body = Cell.Offset(0, 4)
.Save
Cell.Offset(0, 10) = 1
End With

A+ à tous

 

[asfour]

Re : Rendez-vous Outlook via Excel

Bonjour,

Merci pour votre aide ça fonctionne très bien.
merci JCGL.