Sending a selection of cells by email

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.

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.

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.

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.

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.

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

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.

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

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.

yes
@+

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.

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)
@+

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.

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.

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.

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.

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.

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.

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