Problème pour envoi de mail par Gmail avec la méthode CDO

[GuillaumA]

Bonjour. CI-joint la macro COMPLÈTE de mon envoi de mail par Excel.
Cette dernière crée des pièces jointes des feuilles du classeur Excel en .xls

Cette macro marche parfaitement en 2003 (, FileFormat:=56 en moins) et marche a 99% en 2007 (crée les feuilles en .xls, les reconnaît et peu les tuer en fin de macro à travers: Kill NomDesClasseurs(i)

Cependant, à chaque fois, j'ai un echec d'envoi, cela n'arrive pas à atteindre le serveur. La méthode CDO fonctionne-t'elle sous 2007 ? Car je ne verrai que ça comme problème vu qu'apparement le CDO marche parfaitement en 2003 pour la même macro.

Cordialement,
Guillaume

LA MACRO:
J'utilise la librairie: CDO for Windows 2000

'Part 1 - Creation of Workbook corresponding to attached files

 Sub EnvoyerMail()

Dim i As Integer
Dim NomDeLaFeuille As String
Dim NomDesClasseurs(1 To 11)

Dim ZonePJ As Range
Dim ZoneD As Range
Dim ZoneCC As Range
Set ZonePJ = Range("C19:C29")

Dim chemin As String
chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
Dim debutnom As String
debutnom = Range("C38")

Answer = MsgBox(Range("C39"), vbYesNo)
If Answer = vbYes Then

    For i = 19 To 29
        If Not IsEmpty(Range("C" & i)) Then
        NomDeLaFeuille = Range("C" & i)
        NomDesClasseurs(i - 19 + 1) = chemin & "\" & debutnom & NomDeLaFeuille & ".xls"
        Sheets(NomDeLaFeuille).Visible = True
        ThisWorkbook.Sheets(NomDeLaFeuille).Copy
        ActiveWorkbook.SaveAs (chemin & "\" & debutnom & NomDeLaFeuille), FileFormat:=56
        ActiveWorkbook.Close
        Sheets(NomDeLaFeuille).Visible = False
        End If

    Next i

    Call SendMailCDO(NomDesClasseurs)

    For i = 1 To 11
        If NomDesClasseurs(i) <> "" Then Kill NomDesClasseurs(i)
    Next

    ZonePJ.ClearContents

End If

End Sub

'Part 2 - What is going to be sent

Sub SendMailCDO(NomDesClasseurs)

Dim D As String
Dim CC As String
Dim E As String
Dim S As String
Dim T As String
On Error GoTo SMTPSendMail_Err

D = Range("C34").Value
CC = Range("C36").Value
E = Range("C16").Value
S = Range("C4").Value
T = Range("C7").Value & Chr(10) & Chr(10) & Range("C10").Value & Range("C16").Value



Dim Cdo_Message As New CDO.Message
Set Cdo_Message.Configuration = GetSMTPServerConfig()
With Cdo_Message
    .To = D             'Receivers
    .CC = CC            'CC
    .From = E           'Sender
    .Subject = S        'Mail title
    .TextBody = T       'Mail text
    For i = 1 To 11
        If NomDesClasseurs(i) <> "" Then .AddAttachment NomDesClasseurs(i)      'Attached files
    Next
    .send

End With

success = MsgBox(Range("C42"), vbInformation)

Exit Sub
'Errors management

SMTPSendMail_Err:
    tmp = MsgBox(Range("C43") & Chr(10) & Range("C44") & Err.Description, vbCritical)

End Sub

'Part 3 - Server and users informations

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.gmail.com"
.Item(cdoSMTPServerPort) = 465
.Item(cdoSendUserName) = Range("C16").Value     'User name of the user
.Item(cdoSendPassword) = InputBox(Range("C41")) 'Gmail password of the user 
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSMTPUseSSL) = True
.Update
End With

Set GetSMTPServerConfig = Cdo_Config
Set Cdo_Config = Nothing
Set Cdo_Fields = Nothing
End Function

 

[GuillaumA]

Re : Problème pour envoi de mail par Gmail avec la méthode CDO

Voici un fichier exemple pour 2007:

 

[GuillaumA]

Re : Problème pour envoi de mail par Gmail avec la méthode CDO

Le problème vient de la connection au serveur. Le lien ne se fait pas en 2007 malgrès le fait que toutes les caractéristiques sont justes:

et Cdo_Fields = Cdo_Config.Fields
With Cdo_Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "smtp.gmail.com"
.Item(cdoSMTPServerPort) = 465
.Item(cdoSendUserName) = Range("C16").Value     'User name of the user
.Item(cdoSendPassword) = InputBox(Range("C41")) 'Gmail password of the user (not ERM sso password)
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSMTPUseSSL) = True
.Update
End With

cdoSendUsingPort = 2
cdoBasic = 1

J'ai recherché un peu sur internet, et je ne suis pas seul avec ce problème. Bon nombre de gens ont le même avec 2007.

EN effet j'ai bien le (cdoSMTPUseSSL) = True, caractéristique de Gmail, ainsi que 465, le port Gmail et l'identification par SMTP direct avec (cdoSendUsingMethod) = cdoSendUsingPort.

Pourtant.. selon Sending mail from Excel with CDO
Cela devrai marcher avec 2007.

Quelqu'un a t'il déjà eu ce problème ?

Amicalement,
GuillaumA

 

[GuillaumA]

Re : Problème pour envoi de mail par Gmail avec la méthode CDO

J'ai trouvé le problème.
Cela ne vient pas du code, mais du proxy.
Cette solution ne marche pas s'il existe un proxy (très souvent en entreprise)

Si quelqu'un sait comment l'adapter en rentrant le code proxy dans la macro afin que cela marche, je suis preneur

Bonne soirée à tous!

 

[YANN-56]

Re : Problème pour envoi de mail par Gmail avec la méthode CDO

Bonsoir Guillaume, et à ceux qui passeront par ici,

Ce dont tu parles m'intéresse pour deux raisons:

- J'utilise une autre procédure complètement différente qui fonctionne bien chez moi.
(Au passage: En n'ayant rien à fiche du nom du Serveur de l'utilisateur... Ce qui allège beaucoup)

- J'ai voulu la tester sur un poste en réseau d'une entreprise... Echec!!!

D'autant que j'ai dans mon appli un WebBrowser qui teste si oui ou non
une connexion Internet est active... Là aussi: "Plouf"... Bien qu'elle soit effective!

Mes essais datent un peu. J'ai abandonné depuis et les ai laissé à la transmission par Fax.

Si tu poursuis; je veux bien te suivre.
De mon coté; je regarderai à récupérer ce que j'avais tenté de faire.

La solution sera peut-être au bout du partage.

Amicalement.

Yann