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
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