sending a selection of cells by email

Question

Bonjour,  I have an Excel 2010 spreadsheet with columns from "A" to "BC" and rows from "1" to "100". I would like to email only the following selection: $A$3:$AA$55.  If I use the print area option and send the file via email, the recipient receives the entire sheet instead of just the selection.  I am a beginner in VBA; could someone provide a code to do this from a button?  Thank you in advance   Configuration: Windows 7 / Internet Explorer 9.0

Mike-31 · Answer

Hello,   it’s not a problem, you can send the range you want directly in CDO without going through your messaging.  But with a VBA code, you need to be precise. You want to send the range $A$3:$AA$55, but from which sheet, the active sheet or which one and what is its name   and in XLS, XLSX, or PDF format, which offers more security and limits issues related to having Excel and its versions   See you +  Mike-31   A period of failure is an ideal time to sow the seeds of knowledge.

maya · Answer

Hello Mike_31 thank you for your reply my tab is called "FORMULAIRE" actually, this workbook contains a template for people who need to fill it out, and it only sends me back the completed part by email.

Mike-31 · Answer

Re,  I haven't forgotten you, I'll send you a PDF and XLS example this evening.  -- See you later Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

Mike-31 · Answer

Re,  test this file  https://www.cjoint.com/?BJsxn5JSAcU  -- A+ Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

Mike-31 · Answer

Hi,  I wrote it on Excel 2007 and it works perfectly. Following Eriiic's comment, whom I greet, I am reviewing the code to test the Excel versions. I will post a file in the early afternoon that you can test on Excel 2010 and Eriiic on 2003.  -- See you! Mike-31  A period of failure is a perfect moment to sow the seeds of knowledge.

Mike-31 · Answer

Re,  At the beginning of the code, specify the recipient address, SMTP, and possibly the sender's address  Const Dest As Variant = "wwwwwwwwwww@free.fr" Const C_Ent As Variant = "SMTP.free.fr"  Const Exped As Variant = "www.xxxxxxx@free.fr"  https://www.cjoint.com/?BJtl3GkxOPr  -- A+ Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

maya · Answer

RE. Well, guys, the problem is me....  Message in execution  « Microsoft Excel  The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available. »  Without abusing, is there a possibility to open Outlook directly   See you, Maya

Mike-31 · Answer

Re,  I'm letting you know that the code has evolved thanks to the exchanges with Eriiic and thus solves your issues. As for me, I abandoned Outlook a long time ago.  Did you fill in the constants at the beginning of the code (email address, smtp)?  What is your internet service provider?   A+ Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

maya · Answer

Yes, I have correctly entered the email addresses and the SMTP, my internet service provider is Orange thank you anyway @+

Mike-31 · Answer

Re,  You have correctly captured this constant like this with the quotes   Const C_Ent As Variant = "SMTP.orange.fr"  See you later Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

maya · Answer

yes @+

Mike-31 · Answer

Re,  You are indeed using my example file on which you entered the email address and the SMTP  Const Dest As Variant = "wwwwwwwwwww@free.fr" Const C_Ent As Variant = "SMTP.orange.fr"  -- See you later  Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

maya · Answer

re yes, I saved it on my hard drive, I replaced what says mine while respecting the casing now in Outlook I have user information: with a user with a password for connecting to the Orange server (Oleane VPN) @+

Mike-31 · Answer

Re,  Weird because this process doesn’t use any messaging, we go directly with the service provider. However, if you want to use Outlook, I have codes that I can't test.  Restart your computer to see.  See you later Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

eriiic · Answer

Re,  I just retested more thoroughly (on Orange) and it’s okay.   Note that you need to complete/modifier these lines:  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ""  .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "" Mike, could you move them (and the 3 others) to constants at the top of the code? Maybe we should keep Exped and sendusername separate? (in case of using the SMTP from another operator)  Parameter for Oléane: SMTP by: smtp.msa.orange-business.com SMTP port: 587  Otherwise, there is still the possibility of using another operator's SMTP by entering its real email address for the reply. I wanted to test with Gmail (SMTP.gmail.com, port 587) but I get rejected: "...Must issue STARTTLS command first..." Mike, if you've encountered how to activate this TLS during your travels (?)  Eric  PS: By the way, I found this that might help: The reply email address: .item(http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress) = ""  Never will you reply to an unsolicited private message... Well, that's done.

maya · Answer

re When entering the account parameters hard-coded, it works Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxx@xxxxxxxxxxx" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yyyyyyy"  Thank you both, have a great weekend.

Mike-31 · Answer

Re,  these two lines handle the connection authentications this line .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Messaging username" this line .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"  this relates to my question about secure connections, particularly in Switzerland or on certain servers  Otherwise, these two lines can be removed  To answer Eriiic, yes we can raise everything as a constant, it makes modifications easier, that's why I said to wait until I find time to complete the code.  the line you propose  .item(http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress) = "" actually I forgot it, I've handled it as a constant and not placed it in the series of Items Const Exped As Variant = "www.xxxxxxx@free.fr" '----- sender's email address My mistake, it would have been unfortunate for it to be absent from the code. Thanks for this remark   I have proposed this code several times on this forum which can be found, but I will mark the status of this discussion as resolved so that it serves as a reference, in the coming days I will turn it into a tip See you + Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

Mike-31 · Answer

Re,  Here is the complete annotated code  Option Explicit  Sub Send_Email ()  Dim FileExtStr As String  Dim FileFormatNum As Long  Dim Sourcewb, Destwb As Workbook  Dim TempFilePath, TempFileName As String  Dim Wb, iMsg, iConf As Object  Dim Flds As Variant '--------------------------- Constants to specify  Const Sheet As Variant = "FORMULAIRE" '------------- name of the sheet to copy  Const Range As Variant = "A1:H10" '------------------- range to copy  Const Dest As Variant = "michel.wwwwwwwwww@free.fr" '- recipient email address  Const Sender As Variant = "www.xxxxxxx@free.fr" '------ sender reply email address  Const S_Ent As Variant = "SMTP.free.fr" '------------- SMTP address  Const CC As Variant = "" '---------------------------- CC email address  Const BCC As Variant = "" '--------------------------- BCC email address  Const PortNum As Variant = 25 '----------------------- outgoing server port number '--------------------------- If the connection requires authentication  Const UserName As Variant = "Username"  Const Pass As Variant = "password"   On Error GoTo errorHandler  With Application  .ScreenUpdating = False  .EnableEvents = False  End With  Set Sourcewb = ActiveWorkbook  Set Destwb = Workbooks.Add  Sourcewb.Sheets(Sheet).Range(Range).Copy Destwb.ActiveSheet.Range("A1") '--------------------------- Determine Excel version and file extension  With Destwb  If Val(Application.Version) < 12 Then '--------------------------- Excel 97-2003  FileExtStr = ".xls": FileFormatNum = -4143  Else '--------------------------- Excel 2007-2010  If Sourcewb.Name = .Name Then  With Application  .ScreenUpdating = True  .EnableEvents = True  End With  MsgBox "Your response is NO in the security dialog box"  Exit Sub  Else  Select Case Sourcewb.FileFormat  Case 51: FileExtStr = ".xlsx": FileFormatNum = 51  Case 52:  If .HasVBProject Then  FileExtStr = ".xlsm": FileFormatNum = 52  Else  FileExtStr = ".xlsx": FileFormatNum = 51  End If  Case 56: FileExtStr = ".xls": FileFormatNum = 56  Case Else: FileExtStr = ".xlsb": FileFormatNum = 50  End Select  End If  End If  End With  TempFilePath = Environ$("temp") & "\"  '-------------------------- Name of the workbook sent with date and time of sending  TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")  With Destwb  .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum  .Close savechanges:=False  End With  Set iMsg = CreateObject("CDO.Message")  Set iConf = CreateObject("CDO.Configuration")  iConf.Load -1 '--------- CDO Source Default  Set Flds = iConf.Fields  With Flds  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = S_Ent 'smtp.free.fr 'Enter the SMTP of the outgoing server  .Item("http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress") = Sender 'sender reply email   .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = PortNum '25 'outgoing server port number  '--------------------------- If the connection requires authentication uncomment the 3 lines  ' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic  'or  ' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1  ' .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = UserName 'or "Messaging user name"  ' .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass 'or "password"  .Update  End With  With iMsg  Set .Configuration = iConf  .To = Dest  .CC = CC  .BCC = BCC  .From = Sender  .Subject = [C1].Value  .TextBody = "Hello" & " " & [C2].Value & "," & vbCrLf & vbCrLf _  & "Please find attached the " & [C3].Value & "." & vbCrLf & vbCrLf _  & [C4].Value & vbCrLf _  & [C5].Value & vbCrLf _  & [C6].Value & vbCrLf _  & [C7].Value & vbCrLf _  & [C8].Value & vbCrLf _  & [C9].Value & vbCrLf _  & [C10].Value & vbCrLf & vbCrLf _  & [C11]  .AddAttachment TempFilePath & TempFileName & FileExtStr  .Send  End With  With Application  .ScreenUpdating = True  .EnableEvents = True  End With  MsgBox "The email has been successfully sent!" '---------- Send confirmation  Exit Sub '--------------------------- If error exits the procedure errorHandler: '--------------------------- Description of the occurred error  MsgBox Err.Description '--------------------------- If error close the temporary copy  For Each Wb In Workbooks  If Left(Wb.Name, 1)  "Workbook" And Wb.Name  ThisWorkbook.Name Then  Wb.Close  End If  Next Wb End Sub   See you Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

Mike-31 · Answer

Re,  I added a response  I also thought, if the range to copy contains links to cells outside of the copied range or another sheet  we will need to replace this line Sourcewb.Sheets(Feuille).Range(Plage).Copy Destwb.ActiveSheet.Range("A1") which can be written as Sourcewb.Sheets(Feuille).Range(Plage).Copy Destwb.ActiveSheet.[A1]  with, to paste only the values  Sourcewb.Sheets(Feuille).Range(Plage).Copy  Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteValues  potentially adding this line if we want to paste the formats  Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteFormats  and adding this line to deactivate the paste mask, more pleasant to receive  Destwb.ActiveSheet.[A1].Select A+ Mike-31  A period of failure is a perfect time to sow the seeds of knowledge.

maya · Answer

Hi guys, I hope you had a good weekend;  after all the modifications it works, except for one detail which is that the copy does not keep the layout, is there a possibility to fix this  @+ and thanks again maya

Mike-31 · Answer

Re,

what do you mean by layout, the width of the columns
the height of the line
the coloring of certain cells or font

--
A+
Mike-31

A period of failure is a perfect time to sow the seeds of knowledge.

maya · Answer

he keeps everything except the column widths@+ thanks

Mike-31 · Answer

Re,

paste this code in place of the other, don't forget to specify the constants
Const Dest As Variant
Const Exped As Variant
Const C_Ent As Variant
and this one if the range to copy changes
Const Plage As Variant

Sub Envoi_Mail ()

Dim cdoBasic
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb, Destwb As Workbook
Dim TempFilePath, TempFileName As String
Dim Wb, iMsg, iConf As Object
Dim Flds As Variant
'--------------------------- Constants to fill in
Const Feuille As Variant = "FORMULAIRE" '------------- name of the sheet to copy
Const Plage As Variant = "A1:H10" '------------------- range to copy, (Cells.Copy whole sheet)
Const Dest As Variant = "wwwwwwwwwww@free.fr" '- recipient email address
Const Exped As Variant = "www.xxxxxxx@free.fr" '------ reply email address of sender
Const C_Ent As Variant = "SMTP.free.fr" '------------- address of the SMTP (incoming mail)
Const CC As Variant = "" '---------------------------- CC email address
Const BCC As Variant = "" '--------------------------- email address for BCC or BCI or CCI
Const NumPort As Variant = 25 '----------------------- port number of the outgoing server
Const Nom_envoi As Variant = "Sourcewb.Name" '----------- identical name of the sent file or replace with "Desired name"
'--------------------------- If the connection requires authentication
Const N_Messag As Variant = "False" '----------------- Username for messaging, otherwise put "False"
Const Pass As Variant = "False" '--------------------- password otherwise put in False
'--------------------------- SSL connection like gmail and hotmail etc... set the constant to "True" otherwise "False"
Const Typ_Conex As Variant = "False"

'--------------------------- Start of procedure
On Error GoTo errorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Set Destwb = Workbooks.Add
'-- If the range to copy contains links isolate the first row and free up the rows below
Sourcewb.Sheets(Feuille).Range(Plage).Copy
Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteFormats '---- copy formats
Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteValues '----- copy values
Destwb.ActiveSheet.[A1].Select
'--------------------------- Determine the version of Excel and the file extension used
With Destwb
If Val(Application.Version) < 12 Then
'--------------------------- Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'--------------------------- Excel 2007-2010
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog box"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
TempFilePath = Environ$("temp") & "\"
'-------------------------- Name of the sent workbook with date and time of sending
TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close savechanges:=False
End With
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = C_Ent '-------------- Enter the SMTP of the outgoing server e.g. "smtp.free.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress") = Exped 'reply email address of sender
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = NumPort '-------- port number of the outgoing server
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Typ_Conex '---------- Specific connection
'--------------------------- If the connection requires authentication, free the 3 lines
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'or
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = N_Messag ' Username for messaging otherwise False
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass ' password otherwise False
.Update
End With
With iMsg
Set .Configuration = iConf
.To = Dest
.CC = CC
.BCC = BCC
.From = Exped
.Subject = [C1].Value
.TextBody = "Hello" & " " & [C2].Value & "," & vbCrLf & vbCrLf _
& "Please find attached the " & [C3].Value & "." & vbCrLf & vbCrLf _
& [C4].Value & vbCrLf _
& [C5].Value & vbCrLf _
& [C6].Value & vbCrLf _
& [C7].Value & vbCrLf _
& [C8].Value & vbCrLf _
& [C9].Value & vbCrLf _
& [C10].Value & vbCrLf & vbCrLf _
& [C11]
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "The email has been sent successfully!" '------------- Optional, confirmation of sending
Exit Sub
'--------------------------- If error we exit the procedure
errorHandler:
'--------------------------- Description of the error that occurred
MsgBox Err.Description
'--------------------------- If error close the temporary copy
For Each Wb In Workbooks
If Left(Wb.Name, 1) <> "Workbook" And Wb.Name <> ThisWorkbook.Name Then
Wb.Close
End If
Next Wb
End Sub

--
A+
Mike-31

A period of failure is a perfect time to sow the seeds of knowledge.

maya · Answer

Re
I made a test, I have a message that says it's impossible to paste merged cells of different sizes.
Initially, I have columns from A to AA with a column width of 3 to 4, when I receive the file pasted by email, and I open it, I have columns with a width of 10.38
I uploaded the example file online, it might be simpler and better than my explanations:
http://cjoint.com/12oc/BJwrFPNiCOb.htm
@+

maya · Answer

re little detail, the final file will be protected, could this have an impact?

Mike-31 · Answer

Const Dest As Variant = "wwwwwwwwww@free.fr"  
Const Exped As Variant = "www.xxxxxxx@free.fr"  
Const C_Ent As Variant = "SMTP.free.fr"

Si ça bloque il faudra regarder dans ta messagerie le N° du port sortant mais je te dirais plus tard, normalement c'est bien le 25

Option Explicit

Sub Envoi_Mail()

Dim cdoBasic  
 Dim FileExtStr As String  
 Dim FileFormatNum As Long  
 Dim Sourcewb, Destwb As Workbook  
 Dim TempFilePath, TempFileName As String  
 Dim Wb, iMsg, iConf As Object  
 Dim Flds As Variant  
'--------------------------- Constante à renseigner  
 Const Feuille As Variant = "FORMULAIRE" '------------- nom de la feuille à cpier  
 Const Plage As Variant = "Cells" '------------------- plage à copier, (Cells.Copie toute la feuille)  
 Const Dest As Variant = "wwwwwwwwww@free.fr" '- adresse mail du destinataire  
 Const Exped As Variant = "www.xxxxxxx@free.fr" '------ adresse mail de réponse de l'expéditeur  
 Const C_Ent As Variant = "SMTP.free.fr" '------------- adresse du SMTP (courrier entrant)  
 Const CC As Variant = "" '---------------------------- adresse mail CC  
 Const BCC As Variant = "" '--------------------------- adresse mail destinataire pour envoi BCC ou BCI ou CCI  
 Const NumPort As Variant = 25 '----------------------- n° port du serveur sortant  
 Const Nom_envoi As Variant = "Sourcewb.Name" '----------- nom identique du fichier expédié ou remplacer par "Nom souhaité"  
'--------------------------- Si la connexion nécessite une authentification  
 Const N_Messag As Variant = "False" '----------------- Nom utilisateur messagerie, sinon mettre en "False"  
 Const Pass As Variant = "False" '--------------------- motdepasse sinon mettre en Fase  
'--------------------------- Connexion en SSL comme gmail et hotmail etc... mettre la constante en "True" sinon "False"  
 Const Typ_Conex As Variant = "False"

'--------------------------- Début de procédure  
 On Error GoTo errorHandler  
 With Application  
 .ScreenUpdating = False  
 .EnableEvents = False  
 End With  
 Set Sourcewb = ActiveWorkbook  
 Set Destwb = Workbooks.Add  
'-- Si la plage à copier contient des liaisons isoler la première ligne et libérer les lignes au dessous  
 Sourcewb.Sheets(Feuille).Cells.Copy Destwb.ActiveSheet.[A1]  
 ' Sourcewb.Sheets(Feuille).Range(Plage).Copy Destwb.ActiveSheet.[A1]  
 ' Sourcewb.Sheets(Feuille).Range(Plage).Copy  
 ' Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteFormats '---- copie les format  
 ' Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteValues '----- copie les valeurs  
 ' Destwb.ActiveSheet.[A1].PasteSpecial Paste:=xlPasteColumnWidths '---- copie les formats colonnes  
 ' Destwb.ActiveSheet.[A1].Select  
'--------------------------- Déterminer la version d'Excel et d'extension du fichier utilisé  
 With Destwb  
 If Val(Application.Version) < 12 Then  
'--------------------------- Excel 97-2003  
 FileExtStr = ".xls": FileFormatNum = -4143  
 Else  
'--------------------------- Excel 2007-2010  
 If Sourcewb.Name = .Name Then  
 With Application  
 .ScreenUpdating = True  
 .EnableEvents = True  
 End With  
 MsgBox "Votre réponse est NON dans la boîte de dialogue de sécurité"  
 Exit Sub  
 Else  
 Select Case Sourcewb.FileFormat  
 Case 51: FileExtStr = ".xlsx": FileFormatNum = 51  
 Case 52:  
 If .HasVBProject Then  
 FileExtStr = ".xlsm": FileFormatNum = 52  
 Else  
 FileExtStr = ".xlsx": FileFormatNum = 51  
 End If  
 Case 56: FileExtStr = ".xls": FileFormatNum = 56  
 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50  
 End Select  
 End If  
 End If  
 End With  
 TempFilePath = Environ$("temp") & "\"  
 '-------------------------- Nom du classeur expédié avec jour et heure d'envoi  
 TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")  
 With Destwb  
 .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum  
 .Close savechanges:=False  
 End With  
 Set iMsg = CreateObject("CDO.Message")  
 Set iConf = CreateObject("CDO.Configuration")  
 iConf.Load -1 ' CDO Source Defaults  
 Set Flds = iConf.Fields  
 With Flds  
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2  
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = C_Ent '-------------- Saisir le SMTP du serveur sortant ex."smtp.free.fr"  
 .Item("http://schemas.microsoft.com/cdo/configuration/senduserreplyemailaddress") = Exped 'adresse email de réponse expéditeur  
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = NumPort '-------- n° port du serveur sortant  
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Typ_Conex '---------- Connexion particulière  
'--------------------------- Si la connexion nécessite une authentification libérer les 3 lignes  
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic  
 'ou  
 ' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1  
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = N_Messag ' Nom utilisateur messagerie sinon False  
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass ' motdepasse sinon False  
 .Update  
 End With  
 With iMsg  
 Set .Configuration = iConf  
 .To = Dest  
 .CC = CC  
 .BCC = BCC  
 .From = Exped  
 .Subject = [C1].Value  
 .TextBody = "Bonjour" & " " & [C2].Value & "," & vbCrLf & vbCrLf _  
 & "Veuillez trouvez ci-joint le " & [C3].Value & "." & vbCrLf & vbCrLf _  
 & [C4].Value & vbCrLf _  
 & [C5].Value & vbCrLf _  
 & [C6].Value & vbCrLf _  
 & [C7].Value & vbCrLf _  
 & [C8].Value & vbCrLf _  
 & [C9].Value & vbCrLf _  
 & [C10].Value & vbCrLf & vbCrLf _  
 & [C11]  
 .AddAttachment TempFilePath & TempFileName & FileExtStr  
 .Send  
 End With  
 With Application  
 .ScreenUpdating = True  
 .EnableEvents = True  
 End With  
 MsgBox "Le mail a été bien envoyé !" '------------- Facultatif, confirmation de l'envoi  
 Exit Sub  
'--------------------------- Si erreur on sort de la procédure  
errorHandler:  
'--------------------------- Description de l'erreur survenue  
 MsgBox Err.Description  
'--------------------------- Si erreur ferme la copie temporaire  
 For Each Wb In Workbooks  
 If Left(Wb.Name, 1)  "Claseur" And Wb.Name  ThisWorkbook.Name Then  
 Wb.Close  
 End If  
 Next Wb  
End Sub

--  
A+  
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

fabidou49 · Answer

First of all, thank you to the people who explained and provided this macro.

It works very well for me, but instead of sending the workbook in .xls format, I would like to send it in PDF format. I tried replacing .xls with .pdf, but the person receiving the document cannot open it. So I would like to know how to proceed.

Additionally, I would also like to save the sent sheet (still as a PDF) in the folder "c: ....." to keep a record of my sendings.

Last request, and I'm sorry to be so demanding, the sheet I'm creating is a rent receipt. I can set the sending date automatically, but I would like to be able to write this in one or more cells automatically, like the date, example: period from xxx to xxx. The "xxx" will be replaced by the period covered by the receipt, which is from March 1, 2013, to March 31, 2013. It is therefore necessary to manage whether the month has 30 days, 31 days, or 28 days for February.

Thank you in advance for your insights.

Sending a selection of cells by email - Page 2

Suite office suite

My pc turns off by itself and restarts on its own, but not always.

Clean a motorola phone

Thunderbird problem

Ai preview issue

How to eject a hard drive without the eject tab

Make mp4 videos on usb readable but non-copyable

Background

Email address change

Kb5120998: windows 11 features release and optimization