Discussion :

[daddygraffiti]

Hello à tous,

J'ai fais un petit bout de code (cf ci-dessous) qui a pour but de créer un "appointment" dans outlook 2010.

Or, j'aimerai faire 1 seul et même envoi à plusieurs destinataires.

J'ai donc ma petite liste d'emails, ma petite boucle qui remplie mon tableau mais lorsque j'essaye de le décharger sur la propriété .Recipients.Add j'ai une erreur "Compile Error: Type mismatch (Error 13)."

Je pense que cala vient d'un problème de compatibilité sur le type de donnée attendue par .Recipients.Add sachant que mon tableau est en "string"...

==> Pouvez-vous svp m'aider à résoudre cette erreur pour que je puisse faire un seul envoi de l'appointment à plusieurs destinataires ?

Merci !!!

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
28
29
30
31
32
33
34
35
 
            Dim cell As Range
            Dim tablo_mail() As String
            Dim nbmail As Integer
 
            Dim outobj As Outlook.Application
            Dim outappt As Outlook.AppointmentItem
            Set outobj = CreateObject("outlook.application")
            Set outappt = outobj.CreateItem(olAppointmentItem)
 
            For Each cell In ActiveWorkbook.Worksheets("zzzz").Columns("J").Cells.SpecialCells(xlCellTypeConstants)
                If cell.Value Like "?*@?*.?*" Then
                    ReDim Preserve tablo_mail(nbmail)
                    tablo_mail(nbmail) = cell.Value
                    nbmail = nbmail + 1
                End If
            Next cell
 
            With outappt
                .Start = "9:00 AM" & Now
                .End = "9:30 AM" & Now
                .Importance = olImportanceHigh
                .Subject = "A FAIRE"
                .Location = "blue room"
                .Body = .Location
                .AllDayEvent = False
                .ReminderSet = False
                .MeetingStatus = olMeeting
                .Recipients.Add tablo_mail '<<<< Ligne ou est l'erreur Mismatch
                .Display
                '.Send
            End With
 
            Set outappt = Nothing
            Set outobj = Nothing

[pc75]

Bonjour,

As-tu essayé de construire ta liste de destinataires comme ça (au lieu d'un tableau d'adresses) ?

Code :

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

1
2
3
4
5
6
7
8
9
 
            For Each cell In ActiveWorkbook.Worksheets("zzzz").Columns("J").Cells.SpecialCells(xlCellTypeConstants)
                If cell.Value Like "?*@?*.?*" Then
                    tablo_mail = tablo_mail & cell.Value & ";"
                    nbmail = nbmail + 1
                End If
            Next cell
            ' Enlever le dernier point-virgule
            tablo_mail = mid(tablo_mail, 1, Len(tablo_mail) - 1)

[daddygraffiti]

Bonjour pc75,

Merci pour ta réponse, je n'avais pas pensé à cette syntaxe pour l'ajout des mails.

Par contre, impossible d’exécuter la macro avec ton code car j'ai une erreur "Compile Error: Type mismatch (Error 13)" sur le caractère "&" de la ligne :

Code :

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

tablo_mail = tablo_mail & cell.Value & ";"

J'ai d’ailleurs essayer de le remplacer par "and" et "+" mais rien n'y fait.

Si quelqu'un peu nous aider à passer outre ce "mismatch" tout en faisant 1 seul et même envoi à plusieurs destinataires... n'hésitez pas !

[Oliv-]

Bonsoir
Il faut remplacer ta ligne

Code :

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

            Dim tablo_mail() As String

Par

Code :

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

            Dim tablo_mail As String

Ou tu peux aussi écrire

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
            Dim cell As Range
            Dim tablo_mail() As String
            Dim nbmail As Integer
 
            Dim outobj As Outlook.Application
            Dim outappt As Outlook.AppointmentItem
            Set outobj = CreateObject("outlook.application")
            Set outappt = outobj.CreateItem(olAppointmentItem)
 
 
            Dim cell As Range
            Dim tablo_mail() As String
            Dim nbmail As Integer
 
            Dim outobj As Outlook.Application
            Dim outappt As Outlook.AppointmentItem
            Set outobj = CreateObject("outlook.application")
            Set outappt = outobj.CreateItem(olAppointmentItem)
 
 
 
            With outappt
                .Start = "9:00 AM" & Now
                .End = "9:30 AM" & Now
                .Importance = olImportanceHigh
                .Subject = "A FAIRE"
                .Location = "blue room"
                .Body = .Location
                .AllDayEvent = False
                .ReminderSet = False
                .MeetingStatus = olMeeting
 
   For Each cell In ActiveWorkbook.Worksheets("zzzz").Columns("J").Cells.SpecialCells(xlCellTypeConstants)
                If cell.Value Like "?*@?*.?*" Then
    .Recipients.Add cell.Value
                    nbmail = nbmail + 1
                End If
            Next cell
             '<<<< Ligne ou est l'erreur Mismatch
                .Display
                '.Send
            End With
 
            Set outappt = Nothing
            Set outobj = Nothing(nbmail) = cell.Value
                    nbmail = nbmail + 1
                End If
            Next cell
 
            With outappt
                .Start = "9:00 AM" & Now
                .End = "9:30 AM" & Now
                .Importance = olImportanceHigh
                .Subject = "A FAIRE"
                .Location = "blue room"
                .Body = .Location
                .AllDayEvent = False
                .ReminderSet = False
                .MeetingStatus = olMeeting
                .Recipients.Add tablo_mail '<<<< Ligne ou est l'erreur Mismatch
                .Display
                '.Send
            End With
 
            Set outappt = Nothing
            Set outobj = Nothing

[daddygraffiti]

Hello Oliv-,

Merci pour ta réponse et désolé pour la mienne qui arrive un peu tardivement...

Effectivement, cela va de soit qu'il faut enlever les "()" ! Parcontre cela créer une nouvelle erreur :

Erreur d'exécution '-2147221233 (8004010f)'
Echec de l'opération. Impossible de trouver un objet.


La seconde solution que tu proposes fonctionne niquel, je n'y avais pas pensé, thanks !

Bon week-end à tous !

Daddy