Hi,
I had the following VBA code to send emails with multiple attachments (pdf) to recipients depending on a value existing in column C. If column C has the same value the attachments in column G will be sent together to the same email recipiente (column F), but it's not working well.
Criteria: Column C; and is sorted.
Path to pdf file: Column G;
Email recipiente: Column F.
Any help is much appreciated.
code:
Reread Forum rules
as well as
to refresh Your memory how to
>>> use code - tags <<<
I had the following VBA code to send emails with multiple attachments (pdf) to recipients depending on a value existing in column C. If column C has the same value the attachments in column G will be sent together to the same email recipiente (column F), but it's not working well.
Criteria: Column C; and is sorted.
Path to pdf file: Column G;
Email recipiente: Column F.
Any help is much appreciated.
code:
Reread Forum rules
Site Rules - New Users - Please Read
Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...
chandoo.org
Posting a sample workbook
The Chandoo.org Forum now has the facilities to upload files directly into a post. Simply use either the Media icon in the Edit menu or the Upload a File Button next to the Save Changes button Alternatively In the Chandoo.org Blog or here in the Forums you can still upload files using a Free...
chandoo.org
>>> use code - tags <<<
Code:
Sub Envia_Emails1_c()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim rng As Range
Dim FilePath As String
Dim email_corpo As String
Dim email_assunto As String
Dim r As Long
Dim f As Boolean
email_corpo = Range("email_corpo")
email_assunto = Range("email_assunto")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set sh = Sheets("Colaboradores")
On Error Resume Next
Set OutApp = CreateObject(Class:="Outlook.Application")
If OutApp Is Nothing Then
f = True
Set OutApp = CreateObject(Class:="Outlook.Application")
End If
On Error GoTo 0
For Each cell In sh.Columns("F").Cells.SpecialCells(xlCellTypeConstants)
r = cell.Row+1
If sh.Cells(r, "C").Value <> sh.Cells(r - 1, "C").Value Then
If Not OutMail Is Nothing Then
OutMail.Send
Set OutMail = Nothing
End If
If cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
OutMail.SendUsingAccount = OutApp.Session.Accounts.Item(1)
OutMail.To = cell.Value
OutMail.Subject = email_assunto
OutMail.Body = email_corpo
End If
End If
FilePath = Cells(r, "G").Value ' path do ficheiro
If Dir(FilePath) <> "" And Not OutMail Is Nothing Then
OutMail.Attachments.Add FilePath
End If
Next cell
' Last email
If Not OutMail Is Nothing Then
OutMail.Send
Set OutMail = Nothing
End If
If f Then
OutApp.Quit
End If
Set OutApp = Nothing
End Sub
Last edited by a moderator: