Solved

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

Posted on 2004-09-18
8
520 Views
Last Modified: 2013-12-26
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!
0
Comment
Question by:bat6ee
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
8 Comments
 

Author Comment

by:bat6ee
ID: 12095587
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!
0
 
LVL 3

Expert Comment

by:domj
ID: 12119516
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
0
 
LVL 7

Accepted Solution

by:
DrewK earned 500 total points
ID: 12157050
I would suggest rearranging your distribution list so that all of your cost centres are in the same column and all of the corresponding names and addresses for each cost centre are in their respective rows.  It should look something like this:

   |        A         |        B               |                 C                        
--------------------------------------------------------------------
1 | Cost Centre  |    Name            |     E-mail
2 | 110111        |    John Smith     |    jsmith@hotmail.com
3 | 110112        |    John Smith     |    jsmith@hotmail.com
4 | 110150        |    John Smith     |    jsmith@hotmail.com
5 | 112113        |    John Smith     |    jsmith@hotmail.com
6 | 222222        |    Jane Doe        |    jdoe@yahoo.com
etc....

Doing that, you will have more of a database to work with.  It's not "normalized", but it is better structured than what you currently have.

Next, you want to make sure that that each sheet in your workbook is named with the same number found in the "Cost Centre" column (in my example, that would be Excel column A).

Your code can then use a looping sequence to read each cost centre name, attribute that name to the worksheet in your workbook with the same name, and then send the e-mail to the person in the same row that the cost centre was found.

For example:

Public Sub Export_and_Email_Reports()
    Dim objWkbook as Workbook, objCurrWkbk as Workbook
    Dim strCostCentre as String, strName as String, strEmail as String
    Dim i as Integer

    Application.DisplayAlerts = False   'turn off the warning messages for deleting sheets
    Application.ScreenUpdating = False 'turning this off speeds up your program

    Activesheet.Range("A2").Activate  'I put field names in row 1; data begins row 2
    Set objCurrWkbk = ActiveWorkbook  'keep track of your current workbook

    While Activecell.Value <> ""         'do until you reach a blank cell
        strCostCentre = ActiveCell.Value
        strName = ActiveCell.Offset(0,1).Value
        strEmail = ActiveCell.Offset(0,2).Value

        Set objWkbook = Workbooks.Add  'create a new workbook for each cost centre

        objCurrWkbk.Activate
        ActiveWorkbook.Sheets(strCostCentre).Copy After:=objWkbook.Sheets(3)
        objWkbook.Activate

        For i = 1 to 3           'normally a new workbook has three blank worksheets
            Sheets(1).Delete  'delete each blank sheet (we copied the cost sheet as fourth)
        Next
       
        ActiveWorkbook.SaveAs Filename:="C:\" & strCostCenter & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
       
        ActiveWorkbook.Close

       '**need code here to attach workbook to e-mail message. see note below **
       
     Wend

     Application.DisplayAlerts = True         'turn warning messages back on
     Application.ScreenUpdating = True     'turn screen updating back on
End Sub

**I purposely didn't take the time to type out the code for the e-mail message since I'm not sure that the stuff I've put here is what you are looking for.  If it is, I can go the next step and show you how to attach to e-mail message.  I normally use "early binding" and set the reference to Microsoft Outlook Object Library in the VB Editor.**

~DrewK
0
 
LVL 7

Expert Comment

by:DrewK
ID: 12157067
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
0
 
LVL 7

Expert Comment

by:DrewK
ID: 12819016
I have nothing else to add at this time...I believe my response would solve the problem.

DrewK
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

740 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question