XL 2019 envoi pdf d'une feuille par gmail et non pas par outlook

[pascal21]

bonjour à tous
je suis à la recherche d'un code qui permet l'envoi d'une feuille de classeur en pdf via gmail uniquement
j'ai un pc de bureau avec lequel je peux envoyer sans problème depuis outlook mais qui ne fonctionne sur un pc portable avec windows 10
ca ouvre bien outlook mais le message refuse de partir à tous hasard je vous met le code pour outlook vous allez peutetre me trouver ce qui cloche

Sub SendWithAtt()
' Nécessite la référence : Microsoft Outlook 1x Object Library
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurFile As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
CurFile = ThisWorkbook.Path & "\" & "COMMANDE .Pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With olMail
.To = "xxxxxxx@gmail.com; xxxxxxx.org"


.Subject = "COMMANDE  " & Date
.Body = ""
.Attachments.Add CurFile
 .ReadReceiptRequested = True
      .OriginatorDeliveryReportRequested = True
'.Attachments.Add ""C:\Users\Utilisateur\Desktop\COMMANDE.Pdf""
.Display
.Send
End With

 
' Effacer les variables objets
Set olMail = Nothing
Set olApp = Nothing
End Sub

merci de votre aide

 

[pascal21]

Dans tous ceux que j'ai trouvé, aucun ne fonctionnent correctement

 

[wDog66]

Salut Pascal21

L'envoi par Gmail doit passer par CDO
Comme j'utilise principalement Outlook, je ne sais pas si ce code fonctionne toujours

Sub EnvoiGmail()
  Dim oCdo As Object
  Set oCdo = CreateObject("CDO.Message")
  With oCdo
    With .Configuration.Fields
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' NTLM méthod
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
      ' CDO ne connait pas TLS, mais Gmail travaille également en SSL sur le port 465
      .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/smtpusessl") = True
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "nomducompte@gmail.com"      'Remplacer nomducompte par le vrai nom
      .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MdPpourapplication"         'Saisir le mot de passe d'application généré sur Google
      .Update
    End With
    .To = "emaildudestinataire"
    .From = "nomducompte@gmail.com"
    .Subject = "Ceci est mon sujet"
    '.CC = "xxxxx"
    '.BCC = "xxxxxx"
    .TextBody = "Ceci est un essai de mail"
    .Send
  End With
  Set oCdo = Nothing
End Sub

Edit : code modifier après test, celui-ci fonctionne 😉

 

[pascal21]

Bonjour et merci je vais testé mais il me semble que j'ai déjà essayé un code similaire ça bloque au niveau du port SMTP

 

[wDog66]

Bonjour et merci je vais testé mais il me semble que j'ai déjà essayé un code similaire ça bloque au niveau du port SMTP

Alors si vous voulez utiliser ce code depuis une entreprise avec pare-feu, cela ne fonctionnera pas

Mais normalement avec le port 587 et le mot de passe pour application généré par Google, cela devrait fonctionner

A+

 

[pascal21]

Bonjour bah non,c'est depuis chez moi c'est pas dans une entreprise

 

[wDog66]

Re,
C'était juste pour information 🙄
Sinon, j'ai testé ceci à l'instant de chez moi

Sub EnvoiGmail()
  Dim oCdo As Object
  Set oCdo = CreateObject("CDO.Message")
  With oCdo
    With .Configuration.Fields
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' NTLM méthod
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
      ' CDO ne connait pas TLS, mais Gmail travaille également en SSL sur le port 465
      .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/smtpusessl") = True
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "nomducompte@gmail.com"      'Remplacer nomducompte par le vrai nom
      .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MdPpourapplication"         'Saisir le mot de passe d'application généré sur Google
      .Update
    End With
    .To = "emaildudestinataire"
    .From = "nomducompte@gmail.com"
    .Subject = "Ceci est mon sujet"
    '.CC = "xxxxx"
    '.BCC = "xxxxxx"
    .TextBody = "Ceci est un essai de mail"
    .Send
  End With
  Set oCdo = Nothing
End Sub

Le mail part bien et je le reçois bien 😜

 

[pascal21]

Non toujours la même erreur je vais faire autrement du coup