Hi All,
I have a VBA code which creates some excel sheets, saves them and then emails them to the required email address. This works perfectly well, however it requires the user to click on a command button.
What I want it to do is to automatically run the code and send the email every day @21:00.
Any ideas on how to do this? I have tried using Microsoft Task Scheduler which I can get to open the database and run the code using the /x "Macro Name" however it fails on the email part of the code and throws up an error message which states: "ActiveX component cant create object" so wont complete and send the mail.
My code to generate the excel sheets and email are below for info, it errors on the "Set oEmail = oApp.CreateItem(olMailItem)" line when using the task Scheduler but works fine when its run from a command button on the main form:
So any thoughts on why its erroring on the ActiveX or is there a way to run it through some code automatically on a daily basis at a set time within Access?
Cheers,
jdlewin1
I have a VBA code which creates some excel sheets, saves them and then emails them to the required email address. This works perfectly well, however it requires the user to click on a command button.
What I want it to do is to automatically run the code and send the email every day @21:00.
Any ideas on how to do this? I have tried using Microsoft Task Scheduler which I can get to open the database and run the code using the /x "Macro Name" however it fails on the email part of the code and throws up an error message which states: "ActiveX component cant create object" so wont complete and send the mail.
My code to generate the excel sheets and email are below for info, it errors on the "Set oEmail = oApp.CreateItem(olMailItem)" line when using the task Scheduler but works fine when its run from a command button on the main form:
Code:
Option Compare Database
Public Function EOSDailySheetIssueAuto()
Dim objXL As Excel.Application
Dim objXL2 As Excel.Application
Dim objWkb As Excel.Workbook
Dim objWkb2 As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim objSht2 As Excel.Worksheet
Dim db As Database
Dim db2 As Database
Dim rs As Recordset
Dim rs2 As Recordset
Dim myPath As String
Dim myPath2 As String
Dim strExcelName As String
Dim strExcelName2 As String
Dim strpath As String
Dim strpath2 As String
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim ExcelFileName As String
Dim ExcelFileName2 As String
Dim MymsgEmail As String
Dim EmailContact As String
Const conMAX_ROWS = 100
Const conSHT_NAME = "Daily Registration Receipt"
Const conSHT_NAME2 = "Daily Reported Receipt"
'Const conWKB_NAME = "K:\mafi\Oil Diagnostics\0. LIMS\0.1 - Registration\Registration Receipt Temp - EOS Daily.xlsx"
'Const conWKB_NAME2 = "K:\mafi\Oil Diagnostics\0. LIMS\0.1 - Registration\Reported Receipt Temp - EOS Daily.xlsx"
Const conWKB_NAME = "G:\0. LIMS\0.1 - Registration\Registration Receipt Temp - EOS Daily.xlsx"
Const conWKB_NAME2 = "G:\0. LIMS\0.1 - Registration\Reported Receipt Temp - EOS Daily.xlsx"
Const conRANGE = "Registration_Excel_Range_Daily"
Const conRANGE2 = "Reported_Excel_Range_Daily"
Const conRANGE3 = "Daily_Reg_Rec_Date"
Const conRANGE4 = "Daily_Rep_Rec_Date"
'Creates Excel Registration sheet
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("Registration_Daily_List_Holding", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
objSht.Range(conRANGE).CopyFromRecordset rs
objSht.Range(conRANGE3).Value = Date
'Saves Excel Daily Registration sheet and sets strpath for email attachment name
'myPath = "K:\mafi\Oil Diagnostics\0. LIMS\0.1 - Registration\Registration Receipts\"
myPath = "G:\0. LIMS\0.1 - Registration\Registration Receipts\"
strExcelName = "L0001 - EOS - Daily Registration Receipt - " & Format(Now(), "dd.mm.yyyy hh.nn") & ".xlsx"
strpath = myPath & strExcelName
objWkb.SaveAs fileName:=strpath
'Creates Excel Reported sheet
Set db2 = CurrentDb
Set objXL2 = New Excel.Application
Set rs2 = db.OpenRecordset("Reported_Daily_List_Holding", dbOpenSnapshot)
With objXL2
.Visible = True
Set objWkb2 = .Workbooks.Open(conWKB_NAME2)
On Error Resume Next
Set objSht2 = objWkb2.Worksheets(conSHT_NAME2)
If Not Err.Number = 0 Then
Set objSht2 = objWkb2.Worksheets.Add
objSht2.Name = conSHT_NAME2
End If
Err.Clear
On Error GoTo 0
objSht2.Range(conRANGE2).CopyFromRecordset rs2
objSht2.Range(conRANGE4).Value = Date
'Saves Excel Daily Reported sheet and sets strpath2 for email attachment name
'myPath2 = "K:\mafi\Oil Diagnostics\0. LIMS\0.1 - Registration\Registration Receipts\"
myPath2 = "G:\0. LIMS\0.1 - Registration\Registration Receipts\"
strExcelName2 = "L0001 - EOS - Daily Reported Receipt - " & Format(Now(), "dd.mm.yyyy hh.nn") & ".xlsx"
strpath2 = myPath2 & strExcelName2
objWkb2.SaveAs fileName:=strpath2
'Sets name for excel attachments for email
ExcelFileName = strpath
ExcelFileName2 = strpath2
'Sets contact email address from client profile
EmailContact = "jonathan.lewin@eatechnology.com"
'Sets main body of email
MymsgEmail = "Hello," & vbCrLf & vbCrLf
MymsgEmail = MymsgEmail & "Please find attached the list of samples submitted to the laboratory for analysis today (Registration Receipt). These samples have been received and registered in our LIMS system." & vbCrLf & vbCrLf
MymsgEmail = MymsgEmail & "Please review the attached and respond with any corrections." & vbCrLf & vbCrLf
MymsgEmail = MymsgEmail & "All samples approved and issued are detailed in the (Reported Receipt) attached to this email." & vbCrLf & vbCrLf
MymsgEmail = MymsgEmail & "Kind Regards," & vbCrLf & vbCrLf
MymsgEmail = MymsgEmail & "EA Technology" & vbCrLf
MymsgEmail = MymsgEmail & "Oil Diagnostics Laboratory - LIMS" & vbCrLf
MymsgEmail = MymsgEmail & "Email: OilData@eatechnology.com" & vbCrLf
MymsgEmail = MymsgEmail & "Tel: 0151 347 2359"
'Auto Email the PDF & Excel reports
Set oEmail = oApp.CreateItem(olMailItem)
With oEmail
.Recipients.Add EmailContact
'.Recipients.Add "OilData@eatechnology.com"
.Subject = "Oil Diagnostics - L0001 - Daily Registration & Reported Receipts"
.Body = MymsgEmail
.Attachments.Add ExcelFileName
.Attachments.Add ExcelFileName2
.Send
End With
'Close excel workbook
objWkb.Close
objWkb2.Close
End With
Set objSht = Nothing
Set objSht2 = Nothing
Set objWkb = Nothing
Set objWkb2 = Nothing
objXL.Quit
objXL2.Quit
Set objXL = Nothing
Set objXL2 = Nothing
Set rs = Nothing
Set rs2 = Nothing
Set db = Nothing
Set db2 = Nothing
End With
End Function
So any thoughts on why its erroring on the ActiveX or is there a way to run it through some code automatically on a daily basis at a set time within Access?
Cheers,
jdlewin1