Aug 18 2022 02:18 PM
I have several sheets (sheet1, sheet2; sheet3, etc.).
I want to send the content of these sheets to different email addresses. For example
sheet1 to email1@email.email
sheet2 to email2@email.email
sheet3 to email3@email.email
etc...
Any help ?
Aug 18 2022 08:33 PM - edited Aug 18 2022 08:37 PM
Solution@chamseddine_hamdeni You can try below codes to send individual sheets to separate emails. To understand codes better, I have divided it into 3 parts.
Option Explicit
'Generate PDFs for each listed sheet.
Sub GeneratePDFs()
Dim strID As String
Dim shts As Variant, i As Integer
On Error Resume Next
MkDir ThisWorkbook.Path & "\PDF_Files"
Err.Clear
strID = Sheets("SendMail").Range("A2").End(xlDown).Address
shts = Split("Sheet1|Sheet2|Sheet3", "|") 'Declaring sheet names
For i = LBound(shts) To UBound(shts)
Sheets(shts(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\PDF_Files\" & shts(i) & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
OpenAfterPublish:=False
Next
MsgBox "PDF file creation finished successfully.", vbInformation, "PDF Creation"
End Sub
'Send mail to individual each pdf as separate mail.
Public Sub SendMail()
Dim strbody As String
Dim sendTo As String
Dim emailCell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim SalaryMonth, strMailRange As String
Dim shts As Variant, i As Integer
strMailRange = Sheets("SendMail").Range("$A$2").End(xlDown).Address
strbody = "Please check the attached file."
shts = Split("Sheet1|Sheet2|Sheet3", "|") 'Declaring sheet names
i = 0
For Each emailCell In Sheets("SendMail").Range("$A$2", strMailRange)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Attachments.Add ThisWorkbook.Path & "\PDF_Files\" & shts(i) & ".pdf"
.to = emailCell
.Subject = "Sending Mail As PDF"
.HTMLBody = strbody
.Display
'.Send 'Uncomment this line to send mail directly without displaying it.
End With
i = i + 1
Next emailCell
MsgBox "Mail sending completed successfully.", vbInformation, "Mail Sending"
End Sub
'Delete PDFs after sending via mail.
Public Sub DelPDFs()
On Error Resume Next
Kill ThisWorkbook.Path & "\PDF_Files\*.*"
'RmDir ThisWorkbook.Path & "\PDF_Files\"
MsgBox "All PDF files are deleted.", vbInformation, "Delete PDFs"
End Sub
Aug 18 2022 09:00 PM - edited Aug 21 2022 05:20 AM
In this link you will discover different variants of sending e-mails with Excel.
... also sample files to download.
Mail from Excel and make/mail PDF files
none Microsoft site
The third-party products/sites that this article discusses are manufactured by companies that are independent of me. I makes no warranty, implied or otherwise, about the performance or reliability of these products.
Hope I was able to help you with this info/link.
I know I don't know anything (Socrates)
Aug 19 2022 03:42 AM
Thank you @Harun24HR so much for your help... it is so much appreciated.
The PDF are successfully generated (although I don't know where are they stored, but no problem).
However, do I have to send them manually ?
please check the screenshot attached.
Aug 19 2022 04:03 AM
@NikolinoDE thank you for the valuable link you send.
I'm trying to run one of these files. the macros is not running althouh I enabled it from the trust center. can you please check the screenshot and help me ?
Aug 19 2022 08:18 AM
@chamseddine_hamdeni PDFs are stored in same folder where you keep the excel file (you can keep it to any location of hard disk or desktop or document folder). In vba code just delete .Display and write .Send, read codes comments carefully. Also if it helps then tick mark the answer.
Aug 19 2022 12:04 PM
I have no enough words to thank you. Your code is working from the begining but It was my mistake I didn't read the comment.
You saved my life thank you so much. ALLAH YBARIKLIK
Aug 20 2022 03:41 AM
My friend, the VBA codes related to PDF are working perfectly. But when I click send emails I face the following problem:
It is not related with your code but with my settings... can you help me ?
this is a screenshot of my settings:
Aug 20 2022 07:38 PM
Aug 20 2022 11:51 PM
@Harun24HR yes sir I did.
same error with .send and .display
Your code was working perfectly. This error happened after I modified your code from sending 3 sheets to sending 20 sheets.
After that when I came back to 3 sheets it didn't work also.
Aug 18 2022 08:33 PM - edited Aug 18 2022 08:37 PM
Solution@chamseddine_hamdeni You can try below codes to send individual sheets to separate emails. To understand codes better, I have divided it into 3 parts.
Option Explicit
'Generate PDFs for each listed sheet.
Sub GeneratePDFs()
Dim strID As String
Dim shts As Variant, i As Integer
On Error Resume Next
MkDir ThisWorkbook.Path & "\PDF_Files"
Err.Clear
strID = Sheets("SendMail").Range("A2").End(xlDown).Address
shts = Split("Sheet1|Sheet2|Sheet3", "|") 'Declaring sheet names
For i = LBound(shts) To UBound(shts)
Sheets(shts(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\PDF_Files\" & shts(i) & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
OpenAfterPublish:=False
Next
MsgBox "PDF file creation finished successfully.", vbInformation, "PDF Creation"
End Sub
'Send mail to individual each pdf as separate mail.
Public Sub SendMail()
Dim strbody As String
Dim sendTo As String
Dim emailCell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim SalaryMonth, strMailRange As String
Dim shts As Variant, i As Integer
strMailRange = Sheets("SendMail").Range("$A$2").End(xlDown).Address
strbody = "Please check the attached file."
shts = Split("Sheet1|Sheet2|Sheet3", "|") 'Declaring sheet names
i = 0
For Each emailCell In Sheets("SendMail").Range("$A$2", strMailRange)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Attachments.Add ThisWorkbook.Path & "\PDF_Files\" & shts(i) & ".pdf"
.to = emailCell
.Subject = "Sending Mail As PDF"
.HTMLBody = strbody
.Display
'.Send 'Uncomment this line to send mail directly without displaying it.
End With
i = i + 1
Next emailCell
MsgBox "Mail sending completed successfully.", vbInformation, "Mail Sending"
End Sub
'Delete PDFs after sending via mail.
Public Sub DelPDFs()
On Error Resume Next
Kill ThisWorkbook.Path & "\PDF_Files\*.*"
'RmDir ThisWorkbook.Path & "\PDF_Files\"
MsgBox "All PDF files are deleted.", vbInformation, "Delete PDFs"
End Sub