Auto Send Mail from Excel

[brokovich]

Hi there

I am in the process of writing a macro that splits data on a spreadsheet, copies it into a new sheet, and then emails the new sheet to the relevant person before deleting the data.

I have written the below code and the macro appears to work fine, the only problem being that no emails are actually being sent from my Outlook account. I am receiving the message stating that ' a program is trying to send email on your behalf', which indicates that it is trying to send the mail, and I select 'yes', but no mail is actually going out. i have nothing in my sent items and as i am testing the system I have put my own email address in there and I am not receiving any either.

Can anyone help point me in the right direction? I'm not suer where I have gone wrong!

thanks!


Sub SendActiveWorkbook()

Dim sname As String, i As Integer
Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddr As String
Dim Subj As String
Dim BodyText As String


Workbooks.Open Filename:= _
"C:\Documents and Settings\5ERINRED\Desktop\PMS Renewal Oct.xls"

For i = 1 To 3
sname = Choose(i, "ACK", "ACO", "ADB")
On Error Resume Next

Windows("October1.xls").Activate
Selection.AutoFilter Field:=3, Criteria1:=sname
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("PMS Renewal Oct.xls").Activate
ActiveSheet.Paste
Range("E1").Activate
[E2].End(xlDown).Offset(1, 0) = "=Sum(E2:E" & [E2].End(xlDown).Row & ")"
Columns("E").Select
Selection.NumberFormat = "$#,##0"
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With OutMail
.To = Application.VLookup(Range(sname), Sheets("Adviser Names").Range("B4:F6"), 5, False)
.CC = ""
.BCC = ""
.Subject = "PMS Renewal October"
.Body = "Dear" & Application.VLookup(Range(sname), Sheets("Adviser Names").Range("B46"), 3, False) & vbCr & vbCr & _
"Please find attached your PMS Renewal Stats for October." & vbCr & vbCr & "Thanks," & vbCr & vbCr & "Beks"
.Attachments.Add ActiveWorkbook
.Send
End With

Cells.Select
Selection.ClearContents
Windows("October1.xls").Activate
Next i
End Sub

[RobDog888]

http://vbforums.com/showthread.php?t=402068

[brokovich]

Thanks RobDog,

The problem I have is that the spreadsheet needs to be filtered for each individual, this selection copied into a tenmplate, and the template emailed to the individual. I tried using the SendMail command but it appears to ignore the VLOOKUP I have entered for the email address, which is determined by the choose command which also selects the correct filter.

When I ran it this time it did not even attempt to send the mail. Do you have any further suggestions?

Thanks again!

B

[RobDog888]

Prep calling the sendmail function by making those calls first and set to variables perhaps. Then pass the vars to the sendmail function.

[brokovich]

Thanks RobDog

I've now got it to the stage where it is running the macro and bringing up the email with the sheet attached, but not entering the email address. do you know how I can set the variables to make this work?

The email address is found using a VLOOKUP, which looks up the value of sname for that i each time the macro loops.

I am fairly new to VB and am just struggling with this last bit!

B.

[RobDog888]

Post your updated code.

[brokovich]

Thanks Robdog,

Code attached as it works so far. This runs right through to the email with the attachment, but just doesn't select the relevant email address:

Sub SendActiveWorkbook()

Dim sname As String, i As Integer
Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddr As String
Dim Subj As String
Dim BodyText As String


Workbooks.Open Filename:= _
"C:\Documents and Settings\5ERINRED\Desktop\PMS Renewal Oct.xls"

For i = 1 To 3
sname = Choose(i, "ACK", "ACO", "ADB")
On Error Resume Next

EmailAddr = Application.VLookup(Range(sname), Sheets("Adviser Names").Range("B4:F6"), 5, False)

Windows("October.xls").Activate
Selection.AutoFilter Field:=3, Criteria1:=sname
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("PMS Renewal Oct.xls").Activate
ActiveSheet.Paste
Range("E1").Activate
[E2].End(xlDown).Offset(1, 0) = "=Sum(E2:E" & [E2].End(xlDown).Row & ")"
Columns("E").Select
Selection.NumberFormat = "$#,##0"
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
ActiveWorkbook.SendMail EmailAddr, "PMS October"
Cells.Select
Selection.ClearContents
Windows("October.xls").Activate
Next i
End Sub

[RobDog888]

Make sure th variable is holding the value. Take out the "On Error Resume Next" as that hides issues.

Try this sample to see it if populates for you, it does for me.

    Dim blah As String
    Dim blah2 As String
    blah = "[email protected]"
    blah2 = "Subject"
    ActiveWorkbook.SendMail blah, blah2

[brokovich]

Thanks. I have taken out the Error skip and it is erroring on this line:

EmailAddr = Application.VLookup(Range(sname), Sheets("Adviser Names").Range("B4:F6"), 5, False)

The problem is it is not using the vlookup to return the email address in the string. It works fine if you acutally write the email address into the code, but I want it to find the email address in the worksheet based on the item it chooses in the sname = Choose line of code...

[RobDog888]

I see you are referencing the Range function without fully qualifying its parent sheet. This may make it read a different location and return an error.

[brokovich]

I changed it to this but I am still getting an error! It is now saying there is an application-defined or object-defined error??



EmailAddr = Application.VLookup(Sheets("Adviser Names").Range(sname), Sheets("Adviser Names").Range("B4:F6"), 5, False)

[RobDog888]

What is the value for sname? What does B4:F6 look like/values?

[brokovich]

Here is a zipped version of the spreadsheet with the macro in it. The PMS Renewal October sheet the macro refers to is just a blank spreadsheet used as a template.

Hope this helps!

[brokovich]

HI RobDog

Did you have any joy with the example i sent?

thanks

B

[brokovich]

Thanks for looking at this but I have now found a way to resolve the problem.

B

[RobDog888]

No, I havent had any time. What did you do to resolve it?

[brokovich]

Hi there

I used a second choose function for the selection of the email address. It's not the way I would have prefered to do it but it does work!

thanks.

B