InstructorGirl
New member
- Local time
- Yesterday, 20:17
- Joined
- Oct 4, 2012
- Messages
- 7
I am not a programmer and am trying to send reports to multiple recipients from my Access database using Outlook 2010. I am getting a message box that requires me to click on allow for each email. This process will be sending out individualized monthly reports to about 300 technicians so it's not feasible to do this of course, so therefore I am trying to use CDO in my code to send my emails and bypass the Outlook security model.
When I run my subprocedure I get an error message from Access that says, "Object required". Any help would be greatly appreciated. Thanks.
Here is my code:
Public Sub SendReports()
On Error GoTo Err_SendReports
Dim rs As DAO.Recordset
Dim EmailTo, EmailSubj, EmailText, EmailFrom, EmailAtach
Dim oFSO, sFile, sSig, oFile, sText, oFileA, sCurPath
Set rs = CurrentDb.OpenRecordset("Select Distinct tblTechnicians.TechNumber, tblTechnicians.Email FROM tblTechnicians WHERE tblTechnicians.TechNumber is not Null")
EmailFrom = "EmailAddressOfSender"
EmailTo = "rs"
EmailSubj = "Tool Reimbursement Report"
EmailText = "email.txt"
EmailAtach = "rptTechHoursSpent.rtf"
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = "email.txt"
If oFSO.FileExists(sFile) Then
Set oFile = oFSO.OpenTextFile(sFile, 1)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadAll
If Trim(sText) <> "" Then
EmailText = sText
End If
Loop
Else: WScript.Echo "The file was not there."
End If
sCurPath = oFSO.GetAbsolutePathName(".")
Set objEmail = CreateObject("Outlook.Application")
objEmail.From = EmailFrom
objEmail.To = EmailTo
objEmail.Subject = EmailSubj
objEmail.Textbody = EmailText
objEmail.AddAttachment sCurPath & "\" & EmailAtach
objEmail.Configuration.Fields.Item _
= 2
objEmail.Configuration.Fields.Item _
= _
"EmailAddressOfSender"
objEmail.Configuration.Fields.Item _
= 25
objEmail.Configuration.Fields.Update
objEmail.send
oFile.Close
Exit_SendReports:
Exit Sub
Err_SendReports:
MsgBox Err.Description
Resume Exit_SendReports
End Sub
When I run my subprocedure I get an error message from Access that says, "Object required". Any help would be greatly appreciated. Thanks.
Here is my code:
Public Sub SendReports()
On Error GoTo Err_SendReports
Dim rs As DAO.Recordset
Dim EmailTo, EmailSubj, EmailText, EmailFrom, EmailAtach
Dim oFSO, sFile, sSig, oFile, sText, oFileA, sCurPath
Set rs = CurrentDb.OpenRecordset("Select Distinct tblTechnicians.TechNumber, tblTechnicians.Email FROM tblTechnicians WHERE tblTechnicians.TechNumber is not Null")
EmailFrom = "EmailAddressOfSender"
EmailTo = "rs"
EmailSubj = "Tool Reimbursement Report"
EmailText = "email.txt"
EmailAtach = "rptTechHoursSpent.rtf"
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = "email.txt"
If oFSO.FileExists(sFile) Then
Set oFile = oFSO.OpenTextFile(sFile, 1)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadAll
If Trim(sText) <> "" Then
EmailText = sText
End If
Loop
Else: WScript.Echo "The file was not there."
End If
sCurPath = oFSO.GetAbsolutePathName(".")
Set objEmail = CreateObject("Outlook.Application")
objEmail.From = EmailFrom
objEmail.To = EmailTo
objEmail.Subject = EmailSubj
objEmail.Textbody = EmailText
objEmail.AddAttachment sCurPath & "\" & EmailAtach
objEmail.Configuration.Fields.Item _
= 2
objEmail.Configuration.Fields.Item _
= _
"EmailAddressOfSender"
objEmail.Configuration.Fields.Item _
= 25
objEmail.Configuration.Fields.Update
objEmail.send
oFile.Close
Exit_SendReports:
Exit Sub
Err_SendReports:
MsgBox Err.Description
Resume Exit_SendReports
End Sub