Macro to send different files to different people Excel 2007

jppepin

New Member
Joined
Mar 1, 2011
Messages
5
Hello-
I am a basic VB user in excel. I need a macro for Excel 2007 that will send different files to different people in a list using Outlook. Currently, I have a macro encoded so that it saves the current file using the date and the contents of another cell (i.e. 030111 Daily Report). The macro then saves the file under this name for both excel and PDF formats.
What I need help with: A macro that will send the newly created files to particular people. I.E. I would like Bob to get the newly created PDF version, while George gets the excel version.
I have seen Ron de Bruin's website (which is an amazing site!!!) showing how to do this, but my application is a little different. The files that I need to send to multiple people will be newly created, so I won't have a name for each file until the ActiveX button has been pushed.
Can anyone help me? I would greatly appreciate it! Thanks!

-JP
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
I'm not sure I fully understand.
But as for not knowing the file name at send time,
maybe you could create a special folder and send whatever
PDF is there to Bob and whatever XL is there to George
then clear the folder by moving or deleting the files.
 
Upvote 0
Warship,

Thanks for responding to my post so quickly! I am sorry if I was not clear in my description (but from your response, it seems like you understand what I was trying to get across). When I click an ActiveX button, it saves an excel file as 030111 Report and an .pdf file as 030111 Report (the date changes and Report may be changed to "Shipments" at times). After it saves the two files, it attaches both files to an email addressed to several people. Instead of sending the newly created files to everyone, I want the newly created files sent to particular people (i.e. Bob gets PDF, while George gets excel version).

Your idea regarding saving the files in a special folder with a common name is a great idea, but it is very important that the names of the files have a specific name & date associated with them.
 
Upvote 0
Can you post your code?
I still don't understand how if you're saving the files just before sending them,
you wouldn't have the name to use for attaching, but you say you attach them.
You would have to somehow have a table of email addresses indicating file type needed per email address.
Then loop thru the table for each file type to gather who gets what.
 
Upvote 0
Saving the files is done in two parts. I use application.run "macro name" and put multiple application.run's in one ActiveX button.

application.run "macro1"

Sub macro1()
'Saves filename as value of C11 plus the current date
Sheets("Reports").Select
Dim newFile As String, fName As String
fName = Range("C11").Value
newFile = Format$(Date, "mmddyy Report# ") & fName & " MB"
ActiveWorkbook.SaveAs Filename:="Z:\reports\" & newFile

End Sub

application.run "macro2"

Sub macro2()
'Saves filename as value of C11 plus the current date as a PDF
Sheets("Reports").Select
Dim newFile As String, fName As String
fName = Range("C11").Value
newFile = Format$(Date, "mmddyy TK ") & fName & " MB"
ActiveWorkbook.SaveAs Filename:="Z:\finished tanks\2011 Gasoline PDF - do not use\" & newFile & ".pdf"

End Sub

Application.Run "macro3"
Sub macro3()
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Worksheets("Certificate of Analysis").Range("A1:J54")
'Remember the activesheet
Set AWorksheet = ActiveSheet
'Create the mail and send it
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
'.Introduction = "This is a test mail."
' In the "With .Item" part you can add more options
' See the tips on this Outlook example page.
' http://www.rondebruin.nl/mail/tips2.htm
With .Item
.To = "bob@yahoo.com"
.Subject = "CoA: Sub-Premium Gasoline"
.Send
End With
End With
'select the original ActiveCell
rng.Select
End With
'Activate the sheet that was active before you run the macro
AWorksheet.Select
StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
End Sub
---------------------------------------------------------
After these macros, I can't figure out how to attach the new files the email. I have just been able to add it in the body of the email on my prototype thus far (see macro3 - Thanks to Ron de Bruin). Any suggeestions?

-JP
 
Last edited:
Upvote 0
Start with a copy of your Workbook.
Create a table of email addresses (on a new sheet maybe) -col1 with address - col2 with "xl" or "pdf".
Select the table you create and name the range "emailTable".
In a Module place:
Code:
Option Explicit
Dim newFileXL As String, newFilePDF As String, fName As String
Dim fileToAttach As String, emailAddressesXL As String, emailAddressesPDF As String

Sub Macro1()
    'Saves filename as value of C11 plus the current date
    fName = Sheets("Reports").Range("C11").Value
    newFileXL = Format$(Date, "mmddyy Report# ") & fName & " MB"
    newFileXL = "Z:\reports\" & newFile
    ActiveWorkbook.SaveAs Filename:=newFileXL
End Sub

Sub Macro2()
    'Saves filename as value of C11 plus the current date as a PDF
    fName = Sheets("Reports").Range("C11").Value
    newFilePDF = Format$(Date, "mmddyy TK ") & fName & " MB"
    newFilePDF = "Z:\finished tanks\2011 Gasoline PDF - do not use\" & newFilePDF & ".pdf"
    ActiveWorkbook.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=newFilePDF, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Sub

Sub Macro3()
    'process emails
    createEmailAddressLists
    
    emailAddresses = emailAddressesPDF
    fileToAttach = newFilePDF
    sendEmail
    
    emailAddresses = emailAddressesXL
    fileToAttach = newFileXL
    sendEmail
End Sub

Sub createEmailAddressLists()
    Dim x
    emailAddressesPDF = ""
    emailAddressesXL = ""
    For x = 1 To Range("emailTable").Rows.Count
        If Range("emailTable").Cells(x, 2) = "pdf" Then
            emailAddressesPDF = Range("emailTable").Cells(x, 1) & ";" & emailAddressesPDF
        End If
        If Range("emailTable").Cells(x, 2) = "xl" Then
            emailAddressesXL = Range("emailTable").Cells(x, 1) & ";" & emailAddressesXL
        End If
    Next x
End Sub

Sub sendEmail()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .to = emailAddresses
        .CC = ""
        .BCC = ""
        .Subject = "CoA: Sub-Premium Gasoline"
        .Body = "Say something in email body if you want."
        .Attachments.Add fileToAttach
        .Display 'or .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
This is NOT tested and I'm sure I've missed something but it should be a good start, let me know.

Also when posting code tag the beginning with [*code] (minus the *)
and the ending with [*/code] (minus the *)
Makes it so much easier to read.
 
Upvote 0
Thank you very much Warship! I am having trouble with creating the email list though. I have the email list on sheet 3. First column (A) is the person's name, second column (B) is the person's email address, and the third column (C) is PDF or XL. Any idea how to create a macro to use the addresses from sheet 3?
 
Upvote 0
Change this entire sub:
Code:
Sub createEmailAddressLists()
    Dim x, emRng As Range
    Set emRng = Sheets("Sheet3").Range("A1").CurrentRegion
    emailAddressesPDF = ""
    emailAddressesXL = ""
    For x = 1 To emRng.Rows.Count
        If emRng.Cells(x, 3) = "PDF" Then
            emailAddressesPDF = emRng.Cells(x, 1) & " <" & emRng.Cells(x, 2) & "> ;" & emailAddressesPDF
        End If
        If emRng.Cells(x, 3) = "XL" Then
            emailAddressesXL = emRng.Cells(x, 1) & " <" & emRng.Cells(x, 2) & "> ;" & emailAddressesXL
        End If
    Next x
End Sub

In your email address table, col3 is case sensitive, as in "PDF" and "pdf" are different. You need to use "PDF" and "XL". You do not need to name this range. Do not put any other data next to the table and the upper left corner must be in "A1". Also note that the email address sheet (as written) will be in your pdf.

Also in macro1 change: newFileXL = "Z:\reports\" & newFile
To:newFileXL = "Z:\reports\" & newFileXL
 
Upvote 0

Forum statistics

Threads
1,216,326
Messages
6,130,057
Members
449,555
Latest member
maXam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top