email sections of worksheet to different email addresses

[pdeshazier]

I have a workbook which contains a sheet with a dept number column and a sheet with dept #s and email addresses. I need code to create an email for each department which contains only that department's data. i've attached a sample workbook. so, for rows containining department 606 or 607, i'd need an email to go to pam.white@lpnt.net (one email to pam white for dept 606 data and a separate email to pam white for 607 data). for 608, email pdeshazier@yahoo.com. thanks in advance for any assistance!! :hi:

[Kenneth Hobs]

What is the subject? What is the body? IF the data is not in the body, would data be an Excel file attachment with just with their data? IF the data is not in the body, would data be a PDF file attachment with just with their data?

[pdeshazier]

thanks for responding. The subject will likely be populated from the file name OR file name with "yesterday's" date concatenated.

The body - i had planned on it being the data on each row. Our controller is concerned about outputting data in excel for fear of it being changed, though i've tried convincing her we can protect it so that it can't be modified. the only thing i'm unsure of there is whether they can make a copy of a protected workbook, save it and then modify the copy. if not, i favor sending in excel rather than .pdf (which is the direction my controller was going bc pdf cant' be modified). so.... currently, going with controller's preference, attached .pdf file. however, as long as whatever we DO send cannot be modified, i feel our CFO will be okay with any of these solutions.


What is the subject? What is the body? IF the data is not in the body, would data be an Excel file attachment with just with their data? IF the data is not in the body, would data be a PDF file attachment with just with their data?

[ashleyuk1984]

I have a report at work, which I have to send out to multiple people depending on certain values in a column. I understand how time consuming this is... That's why I too decided to write a macro for this!!

This is pretty much the same as what you are describing.
I got bits and pieces of the code from various sources online, but it's a mixture of various codes put together to achieve the result.
I cannot remember the code off the top of my head.
So it sounds this is exactly the same as what you want to do... I'll try to remember to email home and then modify it to suit your needs.
That's if this isn't resolved before then :)

[vert]

pdeshazier,

This should do what you need, save the range to pdf then email off. This is dependent on each of the departments listed in the array existing in the worksheet and being sorted according to the array. Someone else might have a cleaner way but this is what I use changed some to fit this specific sheet.


Sub emailpam()

Dim OutApp, OutMail As Object
Dim Dept, DSplit As Variant
Dim eAddress, FName As String
Dim FirstRow, LastRow, EMR As Integer
Dim rng As Range

Dept = Array(606, 607, 608)

Set OutApp = CreateObject("Outlook.Application")

'Set the first and last row to the first row of your data
FirstRow = 2
LastRow = 2

'Split your data out as the filename can not have / in it.
DSplit = Split(Date - 1, "/")

With ActiveWorkbook.Worksheets(1)

For Each i In Dept
FirstRow = LastRow 'reset the first row of data to where the last ended.
'loop through matching cells to find the last row of this specific department
Do Until .Cells.Range("A" & LastRow).Value <> i
LastRow = LastRow + 1
Loop
'set range of department with headers
Set rng = Range("A1:H1,A" & FirstRow & ":H" & LastRow - 1)
'set the pdf file name
FName = "z:\test\Dept_" & i & "(" & DSplit(2) & "-" & DSplit(0) & "-" & DSplit(1) & ").pdf"
'save pdf. this needs a different range as it does not need the headers listed separately
Range("A" & FirstRow & ":H" & LastRow - 1).ExportAsFixedFormat xlTypePDF, Filename:=FName
'create the email
Set OutMail = OutApp.CreateItem(0)
With OutMail
EMR = 1 'row where the emails address start.
'loop through email worksheet to find correct department
Do Until ActiveWorkbook.Worksheets(2).Cells.Range("A" & EMR).Value = i
EMR = EMR + 1
Loop
'grab email address
eAddress = ActiveWorkbook.Worksheets(2).Cells.Range("B" & EMR).Value
.To = eAddress
'i set the subject to the pdf file name but you can easily change this to the excel workbook name
.Subject = "Dept_" & i & "(" & DSplit(2) & "-" & DSplit(0) & "-" & DSplit(1) & ")"
'add pdf
.Attachments.Add FName
.Send
End With
Next
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

mike

[BigDawg15]

mike,Works brilliantly. Thanks for sharing.BigDawg15

[pdeshazier]

thanks!!!!! i will give this a try!

[Bouchard17]

Hi Mike,

Im just reviewing your code and im confused based on the earlier comments, does your code attach as an excel workbook/PDF or contains the details in the main body?

Amy