Ouvrir un nouveau message gmail via macro excel

**tequillaman** · 10/06/2016, 11h50

Bonjour,
Je reviens vers vous pour un nouveau sujet macro.
J'ai un formulaire qui envoi des informations dans une base de données. Jusque là, pas de soucis.
Je voudrais qu'en même temps, il m'ouvre google chrome, gmail avec le compte par défaut enregistré, incorpore les champs de mon userform dans le corps du message.
Il faudrais que je n'ai plus qu'à choisir les destinataires. En fonction des informations, les destinataires ne sont pas les mêmes.

J'ai vu pas mal de tuto qui permettent d'envoyer le mail directement avec la méthode CDO mais tout est inscrit en dur dans le code.
J'ai également tenté d'ouvrir l'url gmail mais chrome n'est pas mon navigateur pas défaut, il faudrait dont que je le définisse dans la macro d'ouvrir avec chrome. Sinon sa ouvre bien gmail avec le compte par defaut mais sa m'ouvre la boite de messagerie pas nouveau message avec IE.

Code :

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

1
2
Dim url As String
ThisWorkbook.FollowHyperlink "https://mail.google.com/mail/u/0/?tab=cm#inbox?compose=new", , True

Si chrome est mon navigateur par défaut, sa ouvre bien nouveau message je veux maintenant récupérer les contenu de mon userform pour le mettre dans le corps du message.

C'est possible ou je doit en dur lui dir d'ouvrir avec les parametres du message?

Merci pour votre aide

**davido84** · 10/06/2016, 17h34

Il suffit d'utiliser CDO et de renseigner les différentes propriétés requises pour l'envoi d'un message avec les informations contenues dans les champs de ton UserForm.
A+

Invité · 11/06/2016, 13h07

bonjour,
http://www.developpez.net/forums/d14...t/#post7968025

**tequillaman** · 13/06/2016, 09h48

Salut à tous,
J'ai testé ta réponse rdurupt, j'ai une erreur d’exécution '-2147220973 (80040213)': Le transport a échoué dans sa connexion au serveur.
J'ai testé avec smtp.gmail.com même soucis.

**davido84** · 13/06/2016, 16h49

Bonjour,
quelles sont les paramètres que tu as passés à la fonction ?
Pour Gmail le port est 465.
A+

**tequillaman** · 14/06/2016, 11h46

Code :

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

1
2
3
Sub Mail()
MailEnvoi "smtp.googlemail.com", True, "xxxxx.xxxx-xxx@gmail.com", "xxxxx", 465, 10, "xxxxx@gmail.com", "xxxxx@gmail.com", "xxxxx@gmail.com", "Suivi MM plaquettes", "Voici les MM plaquettes", ""
End Sub

J'ai testé avec smtp.gmail.com et j'ai le même problème.

Invité · 14/06/2016, 12h42

Bonjour,

Code :

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

1
2
3
Sub test()
MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
End Sub

Code :

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

1
2
3
4
 MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
'User  = Propriétaire du compte
'PassWord=Mot de passe du propriétaire du compte  
'Expediteur=Mail du propriétaire du compte

Code :

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

1
2
3
Sub Mail()
MailEnvoi "smtp.googlemail.com", True, "xxxxx.xxxx-xxx@gmail.com", "xxxxx", 465, 10, "xxxxx@gmail.com", "xxxxx@gmail.com", "xxxxx@gmail.com", "Suivi MM plaquettes", "Voici les MM plaquettes", ""
End Sub

Code :

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

1
2
3
Sub Mail()
MailEnvoi "smtp.googlemail.com", True, "xxxxx.xxxx-xxx@gmail.com", "xxxxx", 465, 10, "xxxxx.xxxx-xxx@gmail.com", "xxxxx@gmail.com", "xxxxx@gmail.com", "Suivi MM plaquettes", "Voici les MM plaquettes", ""
End Sub

**tequillaman** · 14/06/2016, 16h10

Désolé, en masquant par des xxxx, j'avais mal recopié mais c'est bien ce que j'ai mis. Cela pourrait-il être dû au parfeu de l'entreprise?

**davido84** · 14/06/2016, 16h36

Si tous les paramètres de la macro sont bons désactive l'antivirus seul et fais un test, puis regarde du côté du pare-feu et fais un test.
A+

Invité · 14/06/2016, 17h39

En général le par feu laisse passe le ports mail!

Avec une identification le mail de l'expéditeur et le mail du login son le même (ceux du propriétaire de compte.)

**tequillaman** · 15/06/2016, 08h38

Je ne peux pas désactiver l'antivirus ni le parfeu, on est vérouillé. Les paramètres sont bon rdurupt.

**davido84** · 15/06/2016, 09h23

Il doit bien y avoir quelqu'un qui gère la sécurité informatique et qui peut désactiver temporairement ou désinstaller (quitte à la réinstaller ensuite) ton antivirus.
Fais un test sans l'antivirus et vois ce que cela donne.
Sans ce type de test difficile de savoir pourquoi cela bloque.
A+

**tequillaman** · 16/06/2016, 10h22

Salut,
Il ne veulent pas lever les protections.
Ceci-dit, cela ne doit pas être la cause car si j'utilise se code c'est bon.

Code :

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

'ThisWorkbook.FollowHyperlink "https://mail.google.com/mail/u/0/?tab=cm#inbox?compose=new", , True

**davido84** · 16/06/2016, 14h36

Je pense que les deux procédures sont différentes : l'un est un lien hypertexte tandis que l'autre nécessite la connexion à un réseau.
J'ai eu le même cas que toi (à considérer bien sûr que ton code est correct et tu dis que c'est le cas) : la procédure bloquait sur l'envoi. Elle a correctement fonctionné lorsque l'antivirus a été temporairement désinstallé.
Une demande a été faite au service concerné pour que l'antivirus laisse fonctionner le programme en question, soit en ne bloquant pas l'exécutable de l'application, soit en plaçant les ordinateurs utilisant le programme sur la liste des exceptions.
A+

**tequillaman** · 17/06/2016, 12h04

Aie, se serais dommage. Je n'ai rien modifié au code de rdurupt pour la fonction Mailenvoi, juste mes paramètres de l'appel

Code :

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

1
2
3
Sub Mail()
 MailEnvoi "smtp.googlemail.com", True, "mon adresse@gmail.com", "mon mot de passe", 465, 10, "mon adresse@gmail.com", "adresse b@gmail.com", "", "Suivi MM plaquettes", "Voici les MM plaquettes", ""
End Sub

Je vais voir avec l'admin réseau mais pas gagné.

Dans les références, je n'ai que Microsoft CDO for Windows 2000 Library à cocher?

**tequillaman** · 17/06/2016, 14h42

re,
C'est bon sa fonctionne, c'est mon smtp qui n'était pas bon car je vais pas directement sur gmail mais sur le gmail de mon entreprise.
Si sa peut-être utile, voici mon code.
Il me permet de modifier dans une feuille excel les parametres destinataires, ...

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
Option Private Module
 
'configuration SMTP pour envoi de mail
Public Const MAIL_SENDUSING = 2
 
'Fonction d'envoi d'un e-mail
Public Sub SMTPSendMail(MailDestinataire As String, MailCopie As String, MAIL_FROM As String, MAIL_SMTP_SERVER As String, MAIL_SMTP_SERVERPORT As String)
    Dim objEmail As New CDO.Message
    Dim mConfig As Object
    Dim Commentaire As String
 
    On Error GoTo SMTPSendMail_Err
    Commentaire = ""
 
    'Génération du contenu du mail
    With objEmail
        .From = MAIL_FROM
        .To = MailDestinataire
        .Cc = MailCopie  'Utilisateur + destinataires choisis dans le UserForm en Cc du mail
        .Subject = "Suivi qualité campagne LAC Du " & DateDKP
 
        .textBody = "Bonjour," & Chr(10) & Chr(10) & "   "
        .textBody = .textBody & "Vous trouverez en pièce jointe le document de suivi qualité produit, de la campagne du LAC Châtelet du : " & DateDKP & Chr(10) & Chr(10)
 
        If strResult <> "" Then
            .textBody = .textBody & strResult & Chr(10) & Chr(10)
        End If
 
        .textBody = .textBody & "Bonne réception"
    End With
 
    With objEmail.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = MAIL_SENDUSING              'MAIL_SENDUSING
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = MAIL_SMTP_SERVER           'MAIL_SMTP_SERVER
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = MAIL_SMTP_SERVERPORT   'MAIL_SMTP_SERVERPORT
        .Update
    End With
 
    'Envoie du mail
    objEmail.Send
 
Exit Sub
SMTPSendMail_Err: 'En cas d'erreur, ouvre une fenêtre indiquant la nature de l'erreur et arrête la procédure d'envoi de mail
    MsgBox "Erreur lors de l'envoi de mail. " & vbCrLf & Err.Description
End Sub

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
Public Sub Ta_Fonction()
    Dim MailUser As String
    Dim MailDestinataire As String
    Dim MailCopie As String
    Dim i As Integer
    'Variable paramètrage Serveur d'envoi
    Dim MAIL_FROM As String
    Dim MAIL_SMTP_SERVER As String
    Dim MAIL_SMTP_SERVERPORT As String
 
    MailUser = Sheets("Param Mail").Range("B5")
    MailDestinataire = ""
    MailCopie = ""
 
    'Paramètrage serveur
    MAIL_FROM = Sheets("Param Mail").Range("B5").Value              'Adresse mail de l'utilisateur de Réactualisation Délai
    MAIL_SMTP_SERVER = Sheets("Param Mail").Range("B2").Value       'Adresse du serveur SMTP
    MAIL_SMTP_SERVERPORT = Sheets("Param Mail").Range("B3").Value   'Port SMTP
 
    'Liste des destinataires
    i = 2
    While Sheets("Param Mail").Range("E" & i) > ""
        MailDestinataire = MailDestinataire & Sheets("Param Mail").Range("E" & i) & ","
        i = i + 1
    Wend
    MailDestinataire = Left(MailDestinataire, Len(MailDestinataire) - 1) 'On enlève la dernière virgule
 
    i = 2
    'Liste des copies
    While Sheets("Param Mail").Range("H" & i) > ""
        MailCopie = MailCopie & Sheets("Param Mail").Range("H" & i) & ","
        i = i + 1
    Wend
 
    'Au moins une copie
    If Len(MailCopie) > 1 Then
        MailCopie = Left(MailCopie, Len(MailCopie) - 1) 'On enlève la dernière virgule
    End If
 
 
'    'Demande ajout fichier pour pièce jointe
'    '----------------------------------------------------------------------------
'    Dim fd As FileDialog
'    Dim NameFile As String
'    Set fd = Application.FileDialog(msoFileDialogFilePicker)
'
'    Dim vrtSelectedItem As Variant
'
'    With fd
'        If .Show = -1 Then
'            For Each vrtSelectedItem In .SelectedItems
'
'                'Vérif fichier Excel
'                If Right(vrtSelectedItem, 4) <> ".xls" And Right(vrtSelectedItem, 4) <> "xlsx" And Right(vrtSelectedItem, 4) <> "XLSX" And Right(vrtSelectedItem, 4) <> ".XLS" And Right(vrtSelectedItem, 4) <> "xlsm" And Right(vrtSelectedItem, 4) <> "XLSM" Then
'                    MsgBox "Erreur : Vous n'avez pas sélectionné un Excel. ", vbCritical
'                Else
'
'                    NameFile = vrtSelectedItem
'                End If
'            Next vrtSelectedItem
'        'The user pressed Cancel.
'        Else
'            Exit Sub
'        End If
'    End With
    '----------------------------------------------------------------------------
 
    'Vérification de l'intitulé du mail
    If MsgBox("L'intitulé du mail sera : ""Résultat analyse " & DateDKP & """ Envoyer?", vbYesNo) = vbYes Then
        Call SMTPSendMail(MailDestinataire, MailCopie, MAIL_FROM, MAIL_SMTP_SERVER, MAIL_SMTP_SERVERPORT)
    End If
End Sub

Si besoin de réutiliser, les paramètres pour la PJ sont désactivés dans le code car plus besoin.