Discussion :

[hyrkanie]

Bonjour

dans le tutoriel sur la publication multiple word http://heureuxoli.developpez.com/off...age/#LVIII-D-2 figure cette macro. je cherche à l'envoyer vers l'email en utilisant le paramétre

Code :

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

ActiveDocument.MailMerge.Destination = wdSendToEmail

au lieu d'envoyer les documents vers le répertoire temp.
j'ai crée une colonne supplémentaire dans adresses.xlx dans laquelle figure les email.
et j'ai utilisé ce code

Code :

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

oDoc.MailMerge.Destination = wdSendToEmail

mais ça ne marche pas. Est-ce à dire que l'exemple expliqué ne marche pas avec un document qui n'est pas un document de fusion? merci pour votre aide.
La macro du tutoriel où je cherche à insérer la fusion vers email.
:

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
 
 
Option Explicit
 
 
Sub donneeAvecExcel()
On Error GoTo GestErr
'Déclaration des variables
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim iR As Integer
Dim i As Integer, j As Integer
Dim oDoc As Document
Dim NoFact As Integer
Dim oTbl As Table
Dim stDocName As String
Dim stPath As String
 
 
 
 
 
'Affectation des données aux variables
stPath = ActiveDocument.Path
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open("C:\" & stPath & "\adresses.xlsx")
Set xlSh = xlWb.Worksheets(2)
'Récupération du nombre de lignes et de colonnes
iR = xlSh.UsedRange.Rows.Count
NoFact = 0
 
 
' Récupération des des données de la feuille pour les injecter dans le document.
For i = 2 To iR
    If NoFact <> xlSh.Cells(i, 2) Then
        stDocName = "c:\temp\" & xlSh.Cells(i, 2) & "-" & Format(Date, "yy-mm-dd") & ".docm"
        oDoc.Close
        Set oDoc = Documents.Add("C:\" & stPath & "\pub1.dotm")
        oDoc.Bookmarks(1).Range.Text = xlSh.Cells(i, 1)
        oDoc.Bookmarks(2).Range.Text = xlSh.Cells(i, 2)
        oDoc.Bookmarks(3).Range.Text = xlSh.Cells(i, 3)
        Set oTbl = oDoc.Tables(1)
        oTbl.Rows.Add
        oTbl.Rows.Last.Cells(1).Range.Text = xlSh.Cells(i, 4)
        oTbl.Rows.Last.Cells(2).Range.Text = xlSh.Cells(i, 5)
        Set oTbl = Nothing
        oDoc.SaveAs stDocName
        'Affectation du nouveau numéro de facture pour la comparaison
        NoFact = xlSh.Cells(i, 2)
    Else
        Set oTbl = oDoc.Tables(1)
        oTbl.Rows.Add
        oTbl.Rows.Last.Cells(1).Range.Text = xlSh.Cells(i, 4)
        oTbl.Rows.Last.Cells(2).Range.Text = xlSh.Cells(i, 5)
        Set oTbl = Nothing
        oDoc.Save
    End If
Next i
 
oDoc.Close
 
Set oDoc = Nothing
GestErr:
'Si pas de document ouvert on fait un resume next
If Err.Number = 91 Then Resume Next
MsgBox "Erreur : " & Err.Number & Err.Description
xlWb.Close
xlApp.Quit
Set xlSh = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
 
 
End Sub

[Heureux-oli]

Salut,

Le bout de code du tuto que tu utilises ne fonctionne pas avec les fonctions MailMErge de Word.

Si tu souhaites les envoeyr par mail, il faudra d'autre ligne de code.