asked on

VBA / Macro to distribute different excel sheets via email using a distribution list

I have an excel report which is made up of different sheets for each cost centre. This report has to be emailed to people on a distribution list. However not everybody should get the same report;

I need email recipients to only receive the sheets that relate to them.

I need to automate this process as I am sick to death of doing it manually and creating a separate excel document containing the appropriate cost centre sheets for each manager! Please help a VBA novice!

bat6ee

ASKER

The distribution list is just an excel sheet with the recipients name in the cell in row A and then the cost centre sheets they require in the same column (each different cost centre is on a different row)

i.e.

John Smith
jsmith@hotmail.com
110111
110112
110150
112113

I need email recipients to only receive the sheets that relate to them.

The default email program is Groupwise.

Thanks!

domj

This will work for you:

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function Mail_It()

strPath = "InsertAttachmentFolderPath"
strSender = "InsertSenderAddress"
strSMTP = "InsertSMTPServer"
strSubject = "InsertSubject"
strBody = "InsertMessageBody"
strExt = "InsertFileExtension"

c = 1
r = 1

Do
strRecipient = Cells(r, c) & " <" & Cells(r + 1, c) & ">"
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = strRecipient
.CC = ""
.BCC = ""
.From = "<" & strSender & ">"
.Subject = strSubject
.TextBody = strBody
r = 3
Do
If Not Cells(r, c) = "" Then
.AddAttachment strPath & Cells(r, c) & strExt
r = r + 1
End If
Loop While Not Cells(r, c) = ""
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
c = c + 1
r = 1
Loop While Not Cells(r, c) = ""
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Dom

ASKER CERTIFIED SOLUTION

DrewK

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

DrewK

Oops I forgot.

You'll need to include:

ActiveCell.Offset(1,0).Activate 'go to next line

right above (before) the line of code that reads:

Wend

You'll find "Wend" towards the end of the subroutine.

This is necessary to advance the cursor to read the next line each iteration of the loop!

Sorry...hope I didn't confuse you!

~DrewK

DrewK

I have nothing else to add at this time...I believe my response would solve the problem.

DrewK