Envoie par mail et selection

naubin1 a écrit :

j'ai ajouté les adresse dans from et to

from: test.numeero.un@gmail.com

le message n'a pas pu être envoyé vers le serveur SMTP. le code d’erreur de transport est 0x80040217. la réponse du serveur était not available

tu as vraiment cette adresse ?

n

et en mot de passe j'ai .....

mais ca fonctionne tj pas

Sub SendEmailUsingGmail()

    On Error GoTo Err

    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String

    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' load all default configurations
    mailConfig.Load -1

    Set fields = mailConfig.fields
With NewMail
  .Subject = "résultat "
  .From =
  .To = "
  .CC = ""
  .BCC = ""
  .TextBody = "Veuillez trouver ci-joint bla bla bla "
  .AddAttachment "
End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        'Enable SSL Authentication
        .Item(msConfigURL & "/smtpusessl") = True

        'Make SMTP authentication Enabled=true (1)
        .Item(msConfigURL & "/smtpauthenticate") = 1

        'Set the SMTP server and port Details
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2

        'Set your credentials of your Gmail Account
        .Item(msConfigURL & "/sendusername") = "
        .Item(msConfigURL & "/sendpassword") = "

        'Update the configuration fields
        .Update

    End With
    NewMail.Configuration = mailConfig
    NewMail.Send
    MsgBox ("OK, c'est parti !")

Exit_Err:

    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:
    Select Case Err.Number

    Case -2147220973  'Could be because of Internet Connection
        MsgBox " Could be no Internet Connection !!  -- " & Err.Description

    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Incorrect Credentials !!  -- " & Err.Description

    Case Else   'Rest other errors
        MsgBox "Error occured while sending the email !!  -- " & Err.Description
    End Select

    Resume Exit_Err

End Sub

ben si !

as-tu activé la référence Microsoft CDO ?

Bonjour,

avez-vous résolu votre problème ?

J'ai le même souci que je n'arrive pas à débloquer.

Merci

Daniel

Bonjour,

dadu35 a écrit :

Bonjour,

avez-vous résolu votre problème ?

J'ai le même souci que je n'arrive pas à débloquer.

Merci

Daniel

Autre cas qui fonctionne parfaitement : https://forum.excel-pratique.com/viewtopic.php?p=732420#p732420

Quelle est ta configuration ? quelle est ta messagerie ? OVH ? gmail ? zoho ?

Re-bonjour,

je suis Chez SOSH, donc messagerie de ORANGE.

Ci-dessous mon codage.

Les variables sont toutes valorisées.

Merci si tu peux me renseigner.

Daniel

Sub MailPdfServeur(MailDesti, FicPDF)
'======================================================================
' Envoi du Mail
'======================================================================
    Dim mMessage As Object
    Dim mConfig As Object
    Dim mChps

    Set mConfig = CreateObject("CDO.Configuration")

    Set mChps = mConfig.Fields
    With mChps
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"'
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "465"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxxxx@orange.fr"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yyyyyyy"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Update
    End With

    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = ""
        If MailCopie = "O" Then
            .BCC = MailDesti & ServeurUtil ' le destinataire et l'émetteur en copie cachée
        Else
            .BCC = MailDesti               ' le destinataire en copie cachée
        End If
        .From = ServeurUtil
        .BodyPart.Charset = "iso-8859-1"
        .Subject = "Document comptable
        .TextBody = MailCivil & vbCrLf & vbCrLf & _
        MailText1 & vbCrLf & _
        MailText2 & vbCrLf & _
        MailText3 & vbCrLf & vbCrLf & _
        MailSalut & vbCrLf & vbCrLf & MailSigne
        .AddAttachment FicPDF
        .Send
    End With
    Set mMessage = Nothing

    'Libère les ressources
    Set mConfig = Nothing
    Set mChps = Nothing

End Sub

Pour smtpauthenticate , ne mets pas le 1 entre guillemets

Bonsoir,

merci Steelson. Ca fonctionne super.

Cdt

Daniel