Bonjour

Voilà, j'a un code pour, pour envoyer un mail via excel, tout a l'air de fonctionner, mais le mail ne part pas. Une idée ??
Merci - Cordialement

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
Private Sub Mail_Click()
 Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String
    Dim Chemin As String
    Dim Extension As String
    Dim Mois As String
    Dim Locataire As String
 
    Locataire = Gestion_Loyer.NomPrenomLocataire.Text
    Mois = Mail_Courrier_QuittanceLoyer.Label_Mois.Caption
    NomBase = "C:\Users\Did et Mag\Documents\Gestion Location\Location VBA.xls"
    Extension = ".doc"
    Chemin = "C:\Users\Did et Mag\Documents\Gestion Location\Locataires\"
 
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set WordDoc = appWord.Documents.Open("C:\Users\Did et Mag\Documents\Gestion Location\Quittance mensuel publipostage.doc")
 
    'fonctionnalité de publipostage pour le document spécifié
    With WordDoc.MailMerge
        'Ouvre la base de données
        .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [Publipostage$]"
        ActiveRecord = 3 ' wdNextRecord
 
 
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToPrinter
        .SuppressBlankLines = True
        'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
 
 
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
 
  'Spécifie la fusion la boite mail
 
     With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailSubject = "Special offer"
        .MailAddressFieldName = "Adresse_Mail"
        .SuppressBlankLines = True
        .Execute
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
     End With
 
    Application.ScreenUpdating = True
 
    'Fermeture du document Word
    'ActiveDocument.MailMerge.DataSource.ActiveRecord =
    WordDoc.Application.ActiveDocument.SaveAs Chemin & Locataire & "\" & Mois & Extension
    'WordDoc.Close
    'appWord.Quit
 
Mail_Courrier_QuittanceLoyer.Hide
End Sub