Discussion :

[sara.ahn]

Bonjour, j'espère que vous allez bien

Mon problème est comme suit : J'ai un planning sur Excel sous forme de tableau contenant des noms d'équipements dans une colonne et dans la colonne suivante des dates du contrôle prochain de ces équipements. J'ai essayé de créer une macro pour permettre à partir de ce tableau de créer une tâche qui va s'afficher sur ma messagerie Outlook un jour avant la date du contrôle prévu. Malheureusement, le programme ne marche pas comme il faut, et avec mon niveau faible en VBA, je ne sais plus comment avancer.

Je vous écris ici mon code pour plus de clartés, sachant que A et B sont les colonnes qui contiennent respectivement le nom de l'équipement et la date (les données commencent à partir de la ligne 2)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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("A2:A" & Range("A6").End(xlUp).Row)
    Set MyItem = myOlApp.CreateItem(olAppointmentItem)
 
    With MyItem
        .MeetingStatus = olNonMeeting
        .Subject = Cell.Offset(1, 0)
        .Start = Cell.Offset(1, 1)
        .Save
    End With
 
    Set MyItem = Nothing
Next Cell
 
End Sub

Merci à vous !

[sara.ahn]

Aucune réponse?

Bon un autre problème est apparu : lorsque les cellules contenant les dates sont vides, la tâche est créée quand même (avec une date aléatoire). Donc j'ai essayé d'ajouter la condition :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not IsEmpty (cell) then

....

(Après (for each))


Mais ça n'a pas réglé le problème.

Des suggestions?

merci

[jurassic pork]

hello,
il faudrait que tu nous montres ce que tu as dans ta feuille excel. Tu as peut-être des soucis avec les Offsets.
Avec ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub NouveauRDV_Calendrier()
'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
Dim myOlApp As Object
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range
On Error Resume Next
Set myOlApp = GetObject(, "Outlook.Application")
If myOlApp Is Nothing Then Set myOlApp = CreateObject("Outlook.Application")
On Error GoTo 0
If Not myOlApp Is Nothing Then
For Each Cell In Sheets("Feuil2").Range("A2:A4")
    ' on teste si il n'y a pas de date
    If Not IsEmpty(Cell.Offset(0, 2)) Then
     Set MyItem = myOlApp.CreateItem(olAppointmentItem)
 
      With MyItem
        .MeetingStatus = olNonMeeting
        .Subject = Cell.Offset(0, 1)
        .Start = Cell.Offset(0, 2)
        .Save
      End With
 
     Set MyItem = Nothing
    End If
Next Cell
End If
End Sub

j'obtiens ceci dans outlook (2010) :


Ami calmant, J.P