Astuces Excel
  1. Astuces Excel
  3. Envoyer un courrier électronique Outlook avec pièce jointe et signature
Intereting Posts
Comment puis-je utiliser une formule avec une fonction IF? Pourquoi cette déclaration FI nestede ne renvoie pas mes valeurs prévues? Excel Parsing multi-line Colonne de données via macro avec des strings concaténées Comment puis-je append des conditions à mon équation lors de l'utilisation de WorksheetFunction.MAX dans VBA? Modifier l'arrière-plan lorsque la formule est supprimée par changement d'user Hiérarchisation des files .mpg aux cellules dans Excel Manuel de reference fermé Copier Excel d'une partie de la string entre les caractères Format préformé et données de la ligne supérieure appliquées lors de la création d'une nouvelle feuille de calcul – Excel Rechercher et sortinger les valeurs, returnner les cellules adjacentes Comment bouger les objects dans VBA La bibliothèque Interop.Excel ne fonctionne pas dans WindowsService Exportez la gamme Excel vers csv avec Powershell Importer une feuille de calcul avec des photos dans sharepoint VBA – ajout de caractère à .findnext en boucle ne sort pas de la boucle

Envoyer un courrier électronique Outlook avec pièce jointe et signature

J'ai besoin d'envoyer un courrier électronique Outlook avec la pièce jointe et la signature.

Voici mon code VBA.

Je reçois une erreur "Transport failed toconnect server". Il semble que je ne donne pas une adresse correcte du server SMTP.

De plus, je dois écrire la signature avec le logo de l'entreprise. 

Sub Outlook() Dim Mail_Object As Object Dim Config As Object Dim SMTP_Config As Variant Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Body As Ssortingng Dim Current_date As Date Current_date = DateValue(Now) Email_Subject = "Daily Pending IMs Report (" & Current_date & ")" Email_Send_From = "[email protected]" Email_Send_To = "[email protected]" 'Email_Cc = "[email protected]" Email_Body = "Dear All," & vbCrLf & "" & vbCrLf & "Kindly find Daily Pending IMs Report in the attached files." Set Mail_Object = CreateObject("CDO.Message") On Error GoTo debugs Set Config = CreateObject("CDO.Configuration") Config.Load -1 Set SMTP_Config = Config.Fields With SMTP_Config .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com" .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587 .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") = "[email protected]" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "nnnnnn" .Update End With With Mail_Object Set .Configuration = Config End With 'enter code here Mail_Object.Subject = Email_Subject Mail_Object.From = Email_Send_From Mail_Object.To = Email_Send_To Mail_Object.TextBody = Email_Body Mail_Object.cc = Email_Cc 'Mail_Object.AddAttachment "C:\Pending IMs\Pending IMs.pdf" Mail_Object.Send debugs: If Err.Description <> "" Then MsgBox Err.Description End Sub

Si vous utilisez Outlook, vous n'avez pas besoin de CDO.Configuration

Supprimez simplement toutes les configurations, 

 '// Code will work on Outlook & Excel 2010 Option Explicit Sub Outlook() Dim olItem As Object ' Outlook MailItem Dim App As Object ' Outlook Application Dim Email_Subject, Email_To, Email_Cc, Email_Body As Ssortingng Dim Current_date As Date Set App = CreateObject("Outlook.Application") Set olItem = App.CreateItem(olMailItem) ' olMailItem ' // add signature With olItem .Display End With Current_date = DateValue(Now) Email_Subject = "Daily Pending IMs Report (" & Current_date & ")" Email_To = "[email protected]" Email_Body = "Dear All," & vbCrLf & "" & vbCrLf & "See Report in the attached files." Set olItem.SendUsingAccount = App.Session.Accounts.Item(2) With olItem .Subject = Email_Subject .To = Email_To .HTMLBody = Email_Body & vbCrLf & vbCrLf & .HTMLBody .Attachments.Add ("C:\Temp\file001.pdf") ' update Attachment Path '.Send ' Send directly .Display ' Display it End With ' // Clean up Set olItem = Nothing End Sub

Rappelez-vous que le code fonctionnera sur Outlook et Excel

Testé sur Outlook 2010