PDA

View Full Version : Sending email with attachement with a VBA Code



jeviiii
12-15-2011, 08:34 AM
Hi All:

I am just a brand new member and I am looking for a code to send an email automatically. I have to send this email on monthly basis and it has to be sent to 45 people.

The email has an attachement, To: (two names ), CC: three names.
Subject that is the same, and some text..

I have found this code wich is supposed to work but is not working. Please, have a look and let me know if there is a solution to my problem. Your help will be much appreciated:).
I have found the code in the following website at Rondebruin.nl
Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

If cell.Value Like "A1" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = cell.Value
.CC = cell.Value
.Subject = "Realizimi i Objektivave per muajin Dhjetor 2011"
Dim strbody As String
strbody = "hello" & vbNewLine & vbNewLine & _
"" hi there mr...smith please find attached etc& vbNewLine & _
"sincerely" & vbNewLine & vbNewLine & vbNewLine & _
"Name of employee Name of boss "

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
[/font]

JP2112
12-16-2011, 12:08 PM
Please use [ vba ] tags when posting code.

When you say "is not working" you need to be more specific. What line causes the error and what is the error message?

Where are you running this code? In Outlook?

If it's only sent once a month, can you do it manually?

jeviiii
12-19-2011, 01:46 AM
Hello:),

Thank you for your reply, and I am sorry for not respecting the website rules but as I am new. I totally agree on your remarks.

I found the solution and I was going to post it for other members who might need it.
I had the problem at

[.CC = " hotmail@dot.com; smith@hotmail.com; etc" and not cell value as it will get the To column of email adresses.

Dim strbody As String
.body = "hello" & vbNewLine & vbNewLine & _

So I was missing the [.body =] in the first code.

thnx and i hope the code will be useful for other people, and I am using Outlook 2007.