Discussion :

[grrimag]

Bonjour à tous,

je cherche à envoyer un mail depuis Excel avec une pièce jointe. J'utilise le code suivant:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Private Sub EnvoiMail()
 
ActiveWorkbook.HasRoutingSlip = True
With ActiveWorkbook.RoutingSlip
    .Delivery = xlAllAtOnce
    .Recipients = Array("moi@moi.fr")
    .Subject = "Test envoi mail"
    .Message = "test d'envoi de mail avec pièce jointe" + vbNewLine + "ce mail a été généré automatiquement, merci de ne pas y répondre" + vbNewLine
End With
ActiveWorkbook.Route
 
End Sub

Je rencontre à cela 2 problèmes que je n'arrive pas à résoudre.
- Le premier, le plus important, c'est qu'il y a une demande de confirmation d'envoi de message (Un programme essaie d'envoyer un message de votre part - répondre par envoyer ou ne pas envoyer). Et je voudrais supprimer cette confirmation.
- Le second est que mon message contient, à la fin le texte suivant "----------Le document joint possède un bordereau de routage. Quand vous avez fini de réviser ce document, dans le menu Fichier, cliquez sur Envoyer vers puis sur Destinataire de routage suivant afin de renvoyer le classeur à son expéditeur." que je voudrais supprimer.

J'ai essayé plein de choses (dont sendkeys) sans succès, regardé plein de forums et FAQ, et tutos, j'y arrive pas...:-(

Est-ce que quelqu'un a des idées?

Merci à tous

[Oliv-]

Salut,
c'est mieux d'utiliser CDO pour cela

("Microsoft CDO for Windows 2000 Library")

[grrimag]

Salut,
merci pour cette piste mais je ne ma suis jamais servi de cela.
Est-ce que tu pourrais préciser un peu plus comment faire (packages à installer ou en-têtes de module à écrire ou autre)?

Merci d'avance

[Oliv-]

Voici un exemple :

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
Function SendMailCDO(Sender As String, Receiver As String, _
                     Subject As String, BodyText As String, _
                     Optional BodyHTML As String, _
                     Optional Cc As String, _
                     Optional Bcc As String, _
                     Optional Attach1 As String)
'---------------------------------------------------------------------------------------
' Procedure : SendMailCDO
' Author    : Oliv'
' Date      : 24/04/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
 
    Dim Cdo_Message As New CDO.Message
 
    Set Cdo_Message.Configuration = GetSMTPServerConfig()
 
    With Cdo_Message
        .To = Receiver
        .From = Sender
        .Subject = Subject
        .Cc = Cc
        .Bcc = Bcc
        '.DSNOptions = 2 ' Delivery Status Notification
        'pour indiquer le Corps du Mail en brut.
        .TextBody = BodyText
        'Décommenter pour indiquer le Corps du Mail en HTML.
        '.HTMLBody = BodyHTML
        'Pour envoyer une page WEB en tant que corps du Mail.
        '.CreateMHTMLBody _
         "http://groups.google.com/group/microsoft.public.fr.outlook", _
         CDO.CdoMHTMLFlags.cdoSuppressNone , "", ""
 
        'ou se trouvant sur son pc
        '.CreateMHTMLBody "file:\\C:\INFORMAT\exemples\événements.htm"
 
 
        If Attach1 <> "" Then
            If Len(Dir(Attach1)) > 0 Then
                .AddAttachment (Attach1)
            Else: MsgBox Attach1 & vbCr & "Ce fichier sera ignoré", _
                         , "Fichier à Attacher introuvable !"
            End If
        End If
 
        'Cette commande envoi le Mail
        .Send
    End With
    Set Cdo_Message = Nothing
End Function
 
 
 
Function GetSMTPServerConfig() As Object
 
    Dim Cdo_Config As New CDO.Configuration
    Dim Cdo_Fields As Object
    Set Cdo_Fields = Cdo_Config.Fields
 
    With Cdo_Fields
        .item(cdoSendUsingMethod) = cdoSendUsingPort
        '.Item(cdoSMTPServer) = "smtp.easynet.fr"
        '.Item(cdoSMTPServerPort) = 25
        .Update
    End With
 
    Set GetSMTPServerConfig = Cdo_Config
    Set Cdo_Config = Nothing
    Set Cdo_Fields = Nothing
 
End Function

[grrimag]

Ca marche !!!
Merci!!!