Email 350 different excel files to 350 different emails 2

[Queryman]

I need to distribute 350 different files to 350 email addresses in my company, is there an excel macro that can handle this?

I can create an excel file that would have the email address of the person and the name of the file they would receive in two columns, can that be used to feed the macro?

I need to actually do this twice, send a total of 700 files, 2 per email tomorrow evening. Any assistance would be appreciated.

Thanks,
Michael



Michael

 

[Queryman]

I found an answer by following a link on this site

http://www.rondebruin.nl/mail/folder2/files.htm

Follow up question:
Is there a way to use a template in outlook with this vba code, the template would be an .oft file, or if that is not possible, is there a way to create an expanded .body on the message, I have a long email message that needs to go along with the attachment?

Here is the code from the link noted above:
You must add a reference to the Microsoft outlook Library.
code

1) Go to the VBA editor, Alt -F11
2) Tools>References in the Menu bar
3) Place a Checkmark before Microsoft Outlook ? Object Library
? is the Excel version number


Make a list in Sheet("Sheet1") with
In column A : Names of the people
In column B : E-mail addresses
In column C : 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
and a filename that exist in that row it will create a mail with this information and send it.


Sub TestFile()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value <> "" Then
If cell.Value Like "*@*" And Dir(cell.Offset(0, 1).Value) <> "" Then
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
.Attachments.Add cell.Offset(0, 1).Value
.Display 'Or use Display
End With
Set OutMail = Nothing
End If
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub





Michael

 

[Aubs010]

If you are going to be sending the same text to each person, then use this:

Public Function TestFile()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim cell As Range
    Dim BodyMessage As String
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
    On Error GoTo cleanup
    For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Offset(0, 1).Value <> "" Then
            If cell.Value Like "*@*" And Dir(cell.Offset(0, 1).Value) <> "" Then
                Set OutMail = OutApp.CreateItem(olMailItem)
[COLOR=red]BodyMessage = _
    "Dear " & cell.Offset(0, -1).Value & vbCrLf & vbCrLf & _
    "Please find attached the file as discussed." & vbCrLf & vbCrLf & _
    "If you have any queries, please do not hesitate to contact me." & vbCrLf & vbCrLf & _
    "Regards," & vbCrLf & vbCrLf & _
    "A Person." & vbCrLf[/color][COLOR=green] 'This last vbCrLf puts in a final return so the attachment is on a line of it's own[/color]
                With OutMail
                    .To = cell.Value
                    .Subject = "Testfile"
                    .Body = BodyMessage
                    .Attachments.Add cell.Offset(0, 1).Value
                    .Display  'Or use Display
                End With
                Set OutMail = Nothing
            End If
        End If
    Next cell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Function

If you plan to change the text for each person, then use this:

Public Function TestFile()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim cell As Range
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
    On Error GoTo cleanup
    For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Offset(0, 1).Value <> "" Then
            If cell.Value Like "*@*" And Dir(cell.Offset(0, 1).Value) <> "" Then
                Set OutMail = OutApp.CreateItem(olMailItem)
                With OutMail
                    .To = cell.Value
                    .Subject = "Testfile"
                    .Body = cell.Offset(0, 2).Value
                    .Attachments.Add cell.Offset(0, 1).Value
                    .Display  'Or use Display
                End With
                Set OutMail = Nothing
            End If
        End If
    Next cell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Function

With the first, you change the text in the variable highlighted above. I have separated it out so you can see it more clearly.

With the second one, you will need to write each message for each person in column "D" of the spreadsheet, in the format:

[tt]
Dear John,

Please find attached the file as discussed.

If you have any queries, please do not hesitate to contact me.
Regards,

A Person.

[/tt]

Hope this helps.



Aubs

 

[Aubs010]

Oh and if you want to change the subject for each person, put in the required subject into column "E" on the spreadsheet and substiture the line:

.Subject = "Testfile"

with this one:

.Subject = cell.Offset(0, 3).Value

Aubs

 

[Queryman]

I need to send two files to each person, can that second file name be put in an excel column, how would that change this code?

Also, is there a way to reference an .oft file to use as a template for the emails?

Thanks a lot,




Michael

 

[Aubs010]

Right then, this is what I now have:

Public Function TestFile()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim cell As Range
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
    On Error GoTo cleanup
    For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Offset(0, 1).Value <> "" Then
            If cell.Value Like "*@*" And Dir(cell.Offset(0, 1).Value) <> "" Then
                Set OutMail = OutApp.CreateItem(olMailItem)
                With OutMail
                    .To = cell.Value
                    .Subject = cell.Offset(0, 4).Value
                    .Body = cell.Offset(0, 3).Value
                    .Attachments.Add cell.Offset(0, 1).Value
                    .Attachments.Add cell.Offset(0, 2).Value
                    .Display
                    'If you want the email to be sent automatically,
                    'comment out the line above and uncomment the line below.
                    '.Send
                End With
                Set OutMail = Nothing
            End If
        End If
    Next cell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Function

This is how the excel worksheet looks:

[tt]
Name Email address File 1 File 2 Main body text Subject
+------+-------------+--------------+--------------+--------------------+-----------+
| A | B | C | D | E | F |
|------|-------------|--------------|--------------|--------------------|-----------|
| Home | home@me.me | c:\file1.txt | c:\file4.txt | Copy of files | Subject 1 |
| | | | | | |
|------|-------------|--------------|--------------|--------------------|-----------|
| Mat | mat@mat.mat | c:\file2.txt | c:\file5.txt | Hi Mat, | Subject 2 |
| | | | | Files as promised. | |
| | | | | | |
| | | | | Aubs. | |
|------|-------------|--------------|--------------|--------------------|-----------|
| Jon | jon@jon.jon | c:\file3.txt | c:\file6.txt | Hi there Jon, | Subject 3 |
| | | | | | |
| | | | | hows things? | |
| | | | | | |
| | | | | Have you been | |
| | | | | looking forward | |
| | | | | to getting these | |
| | | | | files? | |
| | | | | | |
| | | | | Call me tomorrow. | |
| | | | | | |
| | | | | Regards, | |
| | | | | | |
| | | | | Aubs | |
+------+-------------+--------------+--------------+--------------------+-----------+
[/tt]

As to which outlook template to use, I'm not sure, you should be able to change the default template used to create a new email...

Aubs

 

[Aubs010]

Sorry, should have mentioned... If you have Outlook 2002(XP) - service pack 2 I think (not Outlook Express - although it may be relevant to that too!), then be warned...

When ever an external program (including VBA from outlook itself) tries to send an email on your behalf, a prompt is displayed asking you to confirm the sending of the email.

It will timer for a few seconds then ask you to click yes or no to sending the email.

There are ways around... It was inplemented in SP2 I believe, however I am sure someone will correct me if I'm wrong!!

Aubs

 

[Aubs010]

Firstly, to use a public function, you need to put it into a module.

Open up Visual Basic editor and on the left you'll see an explorer tree like structure. Right button on one of the sheets and select insert --> Module

A module will then appear below it. Double click on it and paste the code into the blank space on the right.

Then, add a button to the excel spreadsheet. Right mouse button on it and select View Code.

You'll get something like:

Private Sub CommandButton1_Click()

End Sub

change it to be:

Private Sub CommandButton1_Click()
[COLOR=red]TestFile[/color] [COLOR=green] 'This is the name of your function[/color]
End Sub

Aubs

 

[Queryman]

I have run into that before & there is a program called "PTFB" stands for PUSH THE FREAKING BUTTIN, that clicks any button that you train it to push. I have used it before while sending emails using SAS and OUTLOOK and it worked great.
Here is what it does:
Push The Freakin' Button Pro (PTFB Pro) is a utility for automatically handling confirmation screens and other windows that interrupt your workflow. PTFB Pro quietly keeps watch from the system tray. When it sees a window that you have previously targeted it carries out the button and key presses that you have defined, saving you time, irritation and finger-wear.





Michael

 

[Aubs010]

Hmmmm... Is it me or have some of the replies been deleted?

I can't see your original question now and don't remember what the second part was!!

Aubs

 

[Aubs010]

I have heard of similar programs, not really got a use for one at the moment, oh and it is $30 after the 30 day trial!

Aubs

 

[Queryman]

This used to be free, but you are right, now it's only a 30 day trial.



Michael

 

[Queryman]

How did you get the cell in E to format that way? I have a lot of lines(around 25) for each body, can I assign it to a range in the worksheet and reference that, how would that change this line of code
.Body = cell.Offset(0, 3).Value

  Name  Email address     File 1        File 2         Main body text     Subject
+------+-------------+--------------+--------------+--------------------+-----------+
|  A   |     B       |      C       |      D       |        E           |   F       |
|------|-------------|--------------|--------------|--------------------|-----------|
| Home | home@me.me  | c:\file1.txt | c:\file4.txt | Copy of files      | Subject 1 |
|      |             |              |              |                    |           |
|------|-------------|--------------|--------------|--------------------|-----------|
| Mat  | mat@mat.mat | c:\file2.txt | c:\file5.txt | Hi Mat,            | Subject 2 |
|      |             |              |              | Files as promised. |           |
|      |             |              |              |                    |           |
|      |             |              |              | Aubs.              |           |
|------|-------------|--------------|--------------|--------------------|-----------|
| Jon  | jon@jon.jon | c:\file3.txt | c:\file6.txt | Hi there Jon,      | Subject 3 |
|      |             |              |              |                    |           |
|      |             |              |              | hows things?       |           |
|      |             |              |              |                    |           |
|      |             |              |              | Have you been      |           |
|      |             |              |              | looking forward    |           |
|      |             |              |              | to getting these   |           |
|      |             |              |              | files?             |           |
|      |             |              |              |                    |           |
|      |             |              |              | Call me tomorrow.  |           |
|      |             |              |              |                    |           |
|      |             |              |              | Regards,           |           |
|      |             |              |              |                    |           |
|      |             |              |              | Aubs               |           |
+------+-------------+--------------+--------------+--------------------+-----------+

Michael

 

[Aubs010]

to get them to format:
[ul]
[li]type something in a cell[/li]
[li]press and hold ALT and press Enter[/li]
[li]let go of alt and type something else[/li]
[/ul]
you'll see what I mean if you try it!

Using the above, you can type your whole message into one cell (there is a max number of characters, but you'll probably not go over it!!)

Then you should be able to use something like:

.body = Worksheets("[COLOR=red]Sheet2[/color]").Range("[COLOR=blue]A1[/color]").Value

Where Sheet2 is the sheet that contains the cell that contains your message
and A1 is the cell that contains your message

Aubs

 

[Aubs010]

if you still HAVE to use a costome form (.oft) then take a look here:

http://support.microsoft.com/kb/290803/EN-US/

Aubs

 

[Queryman]

Thanks

I did get that to work, wondering whether I could do something like this

.Body = Worksheets("Sheet2").Range("A1,28").Value

with the body message being in those cells?


Formatting the message seems tough, the attachment seem to pop in at the strangest places in the message also.





Michael