I just upgraded from Access 2007 to Access 2013 and my macro now no longer works. I receive the error 'Object doesnt support this property or method'. It errors out at this point:
blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)
Is anyone able to help me figure out what is wrong?
Thanks
Deanna
------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
' ACCESS VBA MODULE: Send E-mail without Security Warning
' (c) 2005 Wayne Phillips ' Written 07/05/2005
' Last updated v1.3 - 11/11/2005
'
' Please read the full tutorial & code here:
' Please leave the copyright notices in place - Thank you.
' This is a test function! - replace the e-mail addresses
' with your own before executing!!
' (CC/BCC can be blank strings, attachments string is optional)
Function SendReport()
Dim myrst As Recordset
Dim myemail As String
Dim mystring As String
Dim mydate As String
Dim nosend As Integer
Dim Recip As String
Dim Subject As Variant
Dim Message As Variant
Dim Attach As Variant
Dim blnSuccessful As Boolean
Dim strHTML As String
On Error GoTo ErrorHandler
'Set message for the email.
strHTML = "<html>" & _
"<body>" & _
"Attached is the Kansas Department of Health and Environment extract of deaths in your county for the most recent reporting period. If there were no deaths reported in your county for this reporting, the attached report will state 'No Reportable Deaths.' Please reply to this e-mail if you have any questions." & _
"</body>" & _
"</html>"
'Open listing of Counties and email address for each county clerk
Set myrst = CurrentDb.OpenRecordset("SELECT [Master Table].County, EmailTable.CountyReport, [Master Table].[E-Mail] FROM [Master Table] INNER JOIN EmailTable ON [Master Table].County = EmailTable.WorkCounty WHERE ((([Master Table].[Title Abbrev]) = 'CC' Or ([Master Table].[Title Abbrev]) = 'CDC'Or ([Master Table].[Title Abbrev]) = 'JC') And (([Master Table].[Job Title]) <> 'Clerk of the District Court - 2')) ORDER BY [Master Table].County")
mydate = Format(Date, "mmddyyyy")
Do
With myrst
'Get email address and report county
myemail = ![E-Mail]
Recip = myemail
mystring = ![CountyReport]
End With
'Open report for the specific county
DoCmd.OpenReport "JuryRevisionReport", acViewPreview, , "County = '" & mystring & "'"
If nosend = 0 Then
' DoCmd.SendObject acReport, "JuryRevisionReport", "PDFFormat(*.pdf)", Recip, "", "", "Jury Revision List for " & mystring & " County", "", False, ""
DoCmd.OutputTo acOutputReport, "", acFormatPDF, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf"
blnSuccessful = FnSafeSendEmail(Recip, "Jury Revision List for " & mystring & " County.", strHTML, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf")
DoCmd.Close acReport, "JuryRevisionReport", acSaveNo
Else
DoCmd.OpenReport "NoJuryRevisionReport", acViewPreview, , "CountyReport = '" & mystring & "'"
' DoCmd.SendObject acReport, "NoJuryRevisionReport", "PDFFormat(*.pdf)", Recip, "", "", "Jury Revision List for " & mystring & " County", "", False, ""
DoCmd.OutputTo acOutputReport, "", acFormatPDF, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf"
blnSuccessful = FnSafeSendEmail(Recip, "Jury Revision List for " & mystring & " County.", strHTML, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf")
DoCmd.Close acReport, "NoJuryRevisionReport", acSaveNo
End If
nosend = 0
myrst.MoveNext
Loop Until myrst.EOF
myrst.Close
Set myrst = Nothing
MsgBox ("All reports have been sent")
ErrorHandler:
If Error = "The OpenReport action was canceled." Then
nosend = 1
Resume Next
Else
MsgBox (Error)
Set myrst = Nothing
End If
End Function
'This is the procedure that calls the exposed Outlook VBA function...
Public Function FnSafeSendEmail(strTo As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachmentPaths As String, _
Optional strCC As String, _
Optional strBCC As String) As Boolean
Dim objOutlook As Object ' Note: Must be late-binding.
Dim objNameSpace As Object
Dim objExplorer As Object
Dim blnSuccessful As Boolean
Dim blnNewInstance As Boolean
'Is an instance of Outlook already open that we can bind to?
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If objOutlook Is Nothing Then
'Outlook isn't already running - create a new instance...
Set objOutlook = CreateObject("Outlook.Application")
blnNewInstance = True
'We need to instantiate the Visual Basic environment... (messy)
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute
objExplorer.Close
Set objNameSpace = Nothing
Set objExplorer = Nothing
End If
blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)
If blnNewInstance = True Then objOutlook.Quit
Set objOutlook = Nothing
FnSafeSendEmail = blnSuccessful
End Function
blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)
Is anyone able to help me figure out what is wrong?
Thanks
Deanna
------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
' ACCESS VBA MODULE: Send E-mail without Security Warning
' (c) 2005 Wayne Phillips ' Written 07/05/2005
' Last updated v1.3 - 11/11/2005
'
' Please read the full tutorial & code here:
' Please leave the copyright notices in place - Thank you.
' This is a test function! - replace the e-mail addresses
' with your own before executing!!
' (CC/BCC can be blank strings, attachments string is optional)
Function SendReport()
Dim myrst As Recordset
Dim myemail As String
Dim mystring As String
Dim mydate As String
Dim nosend As Integer
Dim Recip As String
Dim Subject As Variant
Dim Message As Variant
Dim Attach As Variant
Dim blnSuccessful As Boolean
Dim strHTML As String
On Error GoTo ErrorHandler
'Set message for the email.
strHTML = "<html>" & _
"<body>" & _
"Attached is the Kansas Department of Health and Environment extract of deaths in your county for the most recent reporting period. If there were no deaths reported in your county for this reporting, the attached report will state 'No Reportable Deaths.' Please reply to this e-mail if you have any questions." & _
"</body>" & _
"</html>"
'Open listing of Counties and email address for each county clerk
Set myrst = CurrentDb.OpenRecordset("SELECT [Master Table].County, EmailTable.CountyReport, [Master Table].[E-Mail] FROM [Master Table] INNER JOIN EmailTable ON [Master Table].County = EmailTable.WorkCounty WHERE ((([Master Table].[Title Abbrev]) = 'CC' Or ([Master Table].[Title Abbrev]) = 'CDC'Or ([Master Table].[Title Abbrev]) = 'JC') And (([Master Table].[Job Title]) <> 'Clerk of the District Court - 2')) ORDER BY [Master Table].County")
mydate = Format(Date, "mmddyyyy")
Do
With myrst
'Get email address and report county
myemail = ![E-Mail]
Recip = myemail
mystring = ![CountyReport]
End With
'Open report for the specific county
DoCmd.OpenReport "JuryRevisionReport", acViewPreview, , "County = '" & mystring & "'"
If nosend = 0 Then
' DoCmd.SendObject acReport, "JuryRevisionReport", "PDFFormat(*.pdf)", Recip, "", "", "Jury Revision List for " & mystring & " County", "", False, ""
DoCmd.OutputTo acOutputReport, "", acFormatPDF, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf"
blnSuccessful = FnSafeSendEmail(Recip, "Jury Revision List for " & mystring & " County.", strHTML, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf")
DoCmd.Close acReport, "JuryRevisionReport", acSaveNo
Else
DoCmd.OpenReport "NoJuryRevisionReport", acViewPreview, , "CountyReport = '" & mystring & "'"
' DoCmd.SendObject acReport, "NoJuryRevisionReport", "PDFFormat(*.pdf)", Recip, "", "", "Jury Revision List for " & mystring & " County", "", False, ""
DoCmd.OutputTo acOutputReport, "", acFormatPDF, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf"
blnSuccessful = FnSafeSendEmail(Recip, "Jury Revision List for " & mystring & " County.", strHTML, "L:\Support\District Court\CountyJuryListRevisionDatabase\Reports\" & mystring & ".pdf")
DoCmd.Close acReport, "NoJuryRevisionReport", acSaveNo
End If
nosend = 0
myrst.MoveNext
Loop Until myrst.EOF
myrst.Close
Set myrst = Nothing
MsgBox ("All reports have been sent")
ErrorHandler:
If Error = "The OpenReport action was canceled." Then
nosend = 1
Resume Next
Else
MsgBox (Error)
Set myrst = Nothing
End If
End Function
'This is the procedure that calls the exposed Outlook VBA function...
Public Function FnSafeSendEmail(strTo As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachmentPaths As String, _
Optional strCC As String, _
Optional strBCC As String) As Boolean
Dim objOutlook As Object ' Note: Must be late-binding.
Dim objNameSpace As Object
Dim objExplorer As Object
Dim blnSuccessful As Boolean
Dim blnNewInstance As Boolean
'Is an instance of Outlook already open that we can bind to?
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If objOutlook Is Nothing Then
'Outlook isn't already running - create a new instance...
Set objOutlook = CreateObject("Outlook.Application")
blnNewInstance = True
'We need to instantiate the Visual Basic environment... (messy)
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute
objExplorer.Close
Set objNameSpace = Nothing
Set objExplorer = Nothing
End If
blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)
If blnNewInstance = True Then objOutlook.Quit
Set objOutlook = Nothing
FnSafeSendEmail = blnSuccessful
End Function
