My Laptop is running 64 bit Microsoft 365 Office , My database was created in Access 2013 in 32 bit operating System
I have opened my Database with Microsoft Office Access 64 bit and everything works fine , except when i go to email
I have 2 options of emailing in my database Outlook and Windows Live , Both emails are working fine on the laptop
I have tried both options to email and get the same error {Active X component cant create object ) I have bebuged my database and have no errors..........Thanks for any help..........Bob
This is my complete code for emailing via Outlook
Private Sub SendMailButton_Click()
If IsNull(tbEmailOption.value) = True Or tbEmailOption.value = vbNullString Then
MsgBox "Please make a Email Format Selection!" & vbCrLf & "Close and Re-Open Statements", vbApplicationModal + vbInformation + vbOKOnly
Exit Sub
End If
On Error GoTo Err_Command35_Click
If Me.Dirty = True Then
Me.Dirty = False
Dim myfile1 As String, myfile2 As String, myfile3 As String
End If
Dim mydir As String
mydir = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name)))
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, sndReport As String, strCompany As String
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp As Integer, tbAmount As String
Dim strFormat As String
Dim mytot As Long
mytot = DCount("[InvoiceID]", "qrySelInvoices", "")
Select Case Me.tbEmailOption.value
Case "ADOBE"
strFormat = acFormatPDF
myfile1 = mydir & "Statement.pdf"
myfile2 = mydir & "Invoices.pdf"
myfile3 = mydir & "Terms_and_Conditions.pdf"
Case "WORD"
strFormat = acFormatRTF
myfile1 = mydir & "Statement.rtf"
myfile2 = mydir & "Invoices.rtf"
myfile3 = mydir & "Terms_and_Conditions.rtf"
Case "SNAPSHOT"
strFormat = acFormatSNP
myfile1 = mydir & "Statement.SNP"
myfile2 = mydir & "Invoices.SNP"
myfile3 = mydir & "Terms_and_Conditions.SNP"
Case "TEXT"
strFormat = acFormatTXT
myfile1 = mydir & "Statement.txt"
myfile2 = mydir & "Invoices.txt"
myfile3 = mydir & "Terms_and_Conditions.txt"
Case "HTML"
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoices.htm"
myfile3 = mydir & "Terms_and_Conditions.htm"
Case Else ' catch all others
strFormat = acFormatRTF
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoices.htm"
myfile3 = mydir & "Terms_and_Conditions.htm"
End Select
Select Case Me.OpenArgs
Case "OwnerStatement"
sndReport = "Client_Statement"
lngID = Nz(Me.cbOwnerName.Column(0), 0)
strMail = OwnerEmailAddress(lngID)
tbAmount = Nz(Me.cbOwnerName.Column(5), 0)
strBodyMsg = "To: "
strBodyMsg = strBodyMsg & Nz(DLookup("[ClientTitle]", "tblOwnerInfo", "[OwnerID]=" & lngID), " ") & " "
strBodyMsg = strBodyMsg & Nz(DLookup("[OwnerFirstName]", "tblOwnerInfo", "[OwnerID]=" & lngID), " ") & " "
strBodyMsg = strBodyMsg & Nz(DLookup("[OwnerLastName]", "tblOwnerInfo", "[OwnerID]=" & lngID), "Client")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement/Invoices, Dated:" & " " & Format(Date, "d-mmm-yyyy") & Chr(10) & "Your Statement Total: " & Format(tbAmount, "$ #,##.00") & Chr(10) & Chr(10) & Nz(DLookup("[EmailMessage]", "tblCompanyInfo"), "") & eMailSignature("Best Regards", True) & Chr(10) & Chr(10) & DownloadMessage("PDF") _
DoCmd.OutputTo acOutputReport, sndReport, strFormat, myfile1, False
If ckbTerms = True Then
DoCmd.OutputTo acOutputReport, "TermsAndConditions", strFormat, myfile3, False
End If
If mytot > 0 And ckbStateOnly = False Then
DoCmd.OutputTo acOutputReport, "Invoice", strFormat, myfile2, False
End If
CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID & " AND " & cbOwnerName.Column(0), dbFailOnError 'OwnerChange
Dim myitem As Object ' Outlook.MailItem
Dim myout As Object 'Outlook.Application
Set myout = CreateObject("Outlook.Application") ' New Outlook.Application
Set myitem = myout.CreateItem(0) '(olMailItem)
With myitem
.To = strMail
.Cc = Nz(DLookup("EmailCC", "tblOwnerInfo", "OwnerID = " & lngID), "")
.Bcc = Nz(DLookup("EmailBCC", "tblOwnerInfo", "OwnerID = " & lngID), "")
.Subject = "Your Statement/Invoice" & " from " & Nz(DLookup("[CompanyName]", "tblCompanyInfo"))
.Body = strBodyMsg 'EditMessage:=blEditMail
.Attachments.Add myfile1
If ckbTerms = True Then
.Attachments.Add myfile3
End If
If mytot > 0 And ckbStateOnly = False Then
.Attachments.Add myfile2
End If
'On Error Resume Next
.Send
'On Error GoTo ErrorHandler
End With
Set myitem = Nothing
Set myout = Nothing
cbOwnerName.SetFocus
Case Else
Exit Sub
End Select
ExitProc:
Exit_Command35_Click:
Exit Sub
Err_Command35_Click:
MsgBox Err.Description
Resume Exit_Command35_Click
ErrorHandler:
msgTitle = "Untrapped Error"
msgBtns = vbExclamation
Select Case Err.Number
'User cancelled message (2293 & 2296 are raised
'by Outlook, not Outlook Express).
Case 2501, 2293, 2296
Case Else
MsgBox "Error Number: " & Err.Number & Chr(13) _
& "Description: " & Err.Description & Chr(13) & Chr(13) _
& "(frmBillStatement SendMailButton_Click)", msgBtns, msgTitle
End Select
Resume ExitProc
End Sub
