VBA Email Files

[Zibi]

Hello,
Please help, I need vba to email using outlook 2013 specific files to group of people with subject and Message, all information would be on spreadsheet in the row, the code should stop when last row is empty

column a and b has to: email
column c, d, e and f has CC: emil
column g has file name
column h has file location
column I has message that should be included with the email
column J has subject of the email

Please help

to: to: cc: cc: cc: cc:
email address email address email address email address email address email address File Name File Location Message Subject
John@cast.net Andy@cast.net BOB@cast.net Dan@cast.net jj@cast.net BB@cast.net New C:/EmailFile Email to you Hello
John@cast.net Andy@cast.net BOB@cast.net Dan@cast.net jj@cast.net BB@cast.net Old C:/EmailFile Email to US Call me
BB@cast.net Andy@cast.net File1 C:/EmailFile Email to KR Best

 

[Michael M]

See here for complete code to EMail files to recipients


Mail a different file(s) to each person in a range

 

[Zibi]

Looks like when I post the message all was squished,
Hello, Please help, I need vba to email using outlook 2013 specific files to group of people with subject and Message,
all information would be on spreadsheet in the row,
the code should stop when last row is empty
column a and b has to: email column
c, d, e and f has CC: emil
column g has file name
column h has file location
column I has message that should be included with the email
column J has subject of the email
Please help

 

[Michael M]

Did you look at the link in Post #2 ???

 

[Zibi]

Looks like my post was squished
Hello, Please help, I need vba to email using outlook 2013 specific files to group of people with subject and Message,
all information would be on spreadsheet in the row,
the code should stop when last row is empty
column a and b has to: email
column c, d, e and f has CC: emil
column g has file name
column h has file location
column I has message that should be included with the email
column J has subject of the email

Excel 2010
	A	B	C	D	E	F	G	H	I	J
1	To:	To:	CC:	CC:	CC:	CC:	File Name	File Location	Message	Subject
2	AA@mail.com	BB@mail.com	CC@mail.com	DD@mail.com	EE@mail.com	DE@mail.com	New	C:/Mail	hello	Good
3	CC@mail.com		AA@mail.com				Old	C:/Mail	Hi	Not
4	DD@mail.com	EE@mail.com	DE@mail.com				Old and New	C:/Mail	OK	Yes
Sheet1

 

[Michael M]

??????......Did you look at the link in Post #2 ???

 

[Zibi]

Hi Michal,

Thanks for your help, I just noticed the code you send, how can I change the code to change message and subject for each email line?

Thanks
Zibi

 

[Michael M]

What code ??...I didn't post any code !!!...

 

[Zibi]

Hi Michal,

The code was on the page that I got by following the link on post #2.

Make a list in Sheets("Sheet1") with :

In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)

The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B
and file name(s) in column C:Z it will create a mail with this information and send it.
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send 'Or use .Display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


thank you for your help

 

[Michael M]

change this

With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value

TO

With OutMail
.to = cell.Value
.Subject = cell.Offset(0, 8).Value
.Body = cell.Offset(0, 7).Value