Ouvrir un nouveau message gmail via macro excel

Version imprimable

10/06/2016, 11h50
tequillaman

Ouvrir un nouveau message gmail via macro excel
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:

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
10/06/2016, 17h34
davido84

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+
11/06/2016, 13h07
Invité

bonjour,
http://www.developpez.net/forums/d14...t/#post7968025
13/06/2016, 09h48
tequillaman

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.
13/06/2016, 16h49
davido84

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

Code:

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.

Bonjour,

Code:

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:

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:

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:

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

14/06/2016, 16h10
tequillaman

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?
14/06/2016, 16h36
davido84

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+
14/06/2016, 17h39
Invité

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.)
15/06/2016, 08h38
tequillaman

Je ne peux pas désactiver l'antivirus ni le parfeu, on est vérouillé. Les paramètres sont bon rdurupt.
15/06/2016, 09h23
davido84

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+
16/06/2016, 10h22
tequillaman

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:

'ThisWorkbook.FollowHyperlink "https://mail.google.com/mail/u/0/?tab=cm#inbox?compose=new", , True
16/06/2016, 14h36
davido84

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+

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:

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?

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:

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:

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.

17/06/2016, 18h43
Invité

Bonjour,
Je n'ai jamais douté que le problème venait de la configuration smtp. J'utilise cette fonction depuis 15ans!
17/06/2016, 18h47
davido84

C'était donc bien l'un de tes paramètres qui n'était pas adapté.
A+
17/06/2016, 20h54
tequillaman

Oui, vu que l'entreprise est sur gmail, il fallait que je mette le domaine de l'entreprise dans le smtp.
Merci à vous encore.