Discussion :

[Kestion100]

Bonjour,
Je souhaiterais effectuer un mailing avec fusion/publipostage sous Word mais, dans certains cas, dans le fichier Excel source, la cellule de la colonne destinataires comporte plusieurs adresses mails séparées par des point-virgules pour une ligne.
Outlook plante dans ces cas.

Existe-t-il une solution?

Merci beaucoup

[Heureux-oli]

Salut,

Perso, je ne vois que via VBA. Mais possible que d'autres aient plus d'idées.

[nlbmoi]

Salut

Tu peux peut-être ajouter deux colonnes supplémentaires ou tu récupères les adresses mails séparées (en cherchant le ; dans la cellule)

A+

[hyperion13]

Salut
Un piste ici

[Kestion100]

Trouvé:

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Sub EnvMail()
 
 
Dim wd As Object, editor As Object
    Dim doc As Object
    Dim oMail As Object
    Dim oApp As Object
 
    Dim iR As Integer
    Dim i As Integer
    Dim oDoc As Document
    Dim oDS As MailMergeDataSource
    Dim DocName1 As String
    Dim UAIDEST As String
 
 Dim objDoc As Document
Set objDoc = ActiveDocument
 
    Set oDoc = ActiveDocument
    Set oDS = oDoc.MailMerge.DataSource
    Set oApp = CreateObject("Outlook.Application")
 
 
 
'    Set wd = CreateObject("Word.Application")
    Set doc = ActiveDocument
    doc.Content.Copy
'    Set wd = Nothing
 
 
iR = oDoc.MailMerge.DataSource.RecordCount
'Debug.Print iR
 
'MsgBox iR
 
For i = 1 To iR
 
       Set oMail = oApp.CreateItem(olMailItem)
       With oMail
 
          With oDoc.MailMerge
             'Définition du premier et dernier enregistrement
             .DataSource.FirstRecord = i
 
             .DataSource.LastRecord = iR
             'MsgBox i
               ' Actualisation de l'enregistrement pour la sauvegarde
             .DataSource.ActiveRecord = i
 
 
             DocName1 = .DataSource.DataFields(21).Value
             UAIDEST = .DataSource.DataFields(2).Value
             Debug.Print DocName1
             Debug.Print .DataSource.DataFields(2).Value
 
 
 
           End With
 
           'PARTIE WORD
objDoc.Range.Select
Selection.CopyAsPicture
 
'PARTIE MAIL
Set OutApp = CreateObject("Outlook.Application")
Set outmail = OutApp.CreateItem(0)
Set outlookwordeditor = outmail.GetInspector.WordEditor
If DocName1 <> "" Then
outmail.Display
outlookwordeditor.Range.PasteAndFormat wdFormatOriginalFormatting
End If
With outmail
.Subject = "ENQUETE " & UAIDEST & " VERIFICATION CONTACT"
.To = DocName1
If .To <> "" Then
.send
End If
End With
 
 
 
 
       End With
 
Next i
MsgBox (i - 1) & " mails envoyés"
 
 
End Sub