PDA

View Full Version : Solved: Email from a range within spreadsheet.



bacon
02-21-2006, 02:23 AM
Morning


I currently have to hard code my email addresses into my vba see highlighted below... What i would ideally like is for the emails to be picked up from a range on my spreadsheet... Can anyone help?

Finally is there an easy way of get this macro to run automatically at a certain time in the day...?

Sub Mail_ActiveSheet_Outlook()

'You must add a reference to the Microsoft outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim wb As Workbook
Dim strdate As String
Application.Run "FuelOilIndications2.xls!Macro4"
strdate = Format(Now, "dd-mm-yy h-mm-ss")
strdateonly = Format(Now, "dd-mmm-yy")
Application.ScreenUpdating = False
Sheets("Fuel Oil Prices").Copy
Set wb = ActiveWorkbook
With wb
.SaveAs "Fuel" & " " & strdate & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = ""
.CC = ""
.BCC = "test@test.com (test@test.com)"
.Subject = "indications" & " " & strdateonly
.Body = "Please find attached fuel swap price indications as of 17.00 today. "
.HTMLBody = " Please find attached "

.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'or use .Display

OutMail.Display
Application.SendKeys "%s", True
Set OutMail = Nothing

End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Many Thanks

Iain

Bob Phillips
02-21-2006, 02:46 AM
Sub Mail_ActiveSheet_Outlook()
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim wb As Workbook
Dim strdate As String

Application.Run "FuelOilIndications2.xls!Macro4"
strdate = Format(Now, "dd-mm-yy h-mm-ss")
strdateonly = Format(Now, "dd-mmm-yy")
Application.ScreenUpdating = False
Sheets("Fuel Oil Prices").Copy
Set wb = ActiveWorkbook
With wb

.SaveAs "Fuel" & " " & strdate & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = .Range("A1").Value
.CC = .Range("B1").Value
.BCC = .Range("C1").Value
.Subject = "indications" & " " & strdateonly
.Body = "Please find attached fuel swap price indications as of 17.00 today. "
.HTMLBody = " Please find attached "

.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'or use .Display

.Display
Application.SendKeys "%s", True

End With

.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

End With

Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

bacon
02-21-2006, 02:59 AM
i tried this but keep getting a VBA 400 error....

Bob Phillips
02-21-2006, 03:09 AM
I presume it happens on the To line. I have just amended it so please try again.

bacon
02-21-2006, 03:12 AM
hmmmm I am now getting... "Object doesn't support this property or method..."

Bob Phillips
02-21-2006, 03:43 AM
Try again


Sub Mail_ActiveSheet_Outlook()
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim wb As Workbook
Dim strdate As String

Application.Run "FuelOilIndications2.xls!Macro4"
strdate = Format(Now, "dd-mm-yy h-mm-ss")
strdateonly = Format(Now, "dd-mmm-yy")
Application.ScreenUpdating = False
Sheets("Fuel Oil Prices").Copy
Set wb = ActiveWorkbook
With wb

.SaveAs "Fuel" & " " & strdate & ".xls"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = wb.ActiveSheet.Range("A1").Value
.CC = wb.ActiveSheet.Range("B1").Value
.BCC = wb.ActiveSheet.Range("C1").Value
.Subject = "indications" & " " & strdateonly
.Body = "Please find attached fuel swap price indications as of 17.00 today. "
.HTMLBody = " Please find attached "

.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'or use .Display

.Display
Application.SendKeys "%s", True

End With

.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

End With

Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

bacon
02-21-2006, 03:49 AM
thank you for help with this...



I think it may have something to do with the email range is on a separate sheet to the macro...

I have attached the spreadsheet....

Bob Phillips
02-21-2006, 04:42 AM
Okay, one more try

bacon
02-21-2006, 05:02 AM
many many thanks and it is working well now...

the only thing is now it brings up a boxfrom outlook with the following text

"A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this"

I managed to override this message before so i am slightly confused why it has start showing again....

Bob Phillips
02-21-2006, 05:10 AM
many many thanks and it is working well now...

the only thing is now it brings up a boxfrom outlook with the following text

"A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this"

I managed to override this message before so i am slightly confused why it has start showing again....

This is extra security in Outlook. It can be overcome, see http://www.rondebruin.nl/mail/prevent.htm, the Oulook part.

bacon
02-21-2006, 05:12 AM
once again thank you for your help