I have a Access Aplication that emails out Statements and Invoices. Which works fine from my 32 bit operating Computer, When I moved my Access Database to a 64 bit operating computer when i try to email I am getting this error: "ActiveX component cant create object"
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
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
Dim myitem As Object
Dim myout As Object
Set myout = CreateObject("Outlook.Application")
Set myitem = myout.CreateItem(0)
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
.Attachments.Add myfile1
If ckbTerms = True Then
.Attachments.Add myfile3
End If
If mytot > 0 And ckbStateOnly = False Then
.Attachments.Add myfile2
End If
.Send
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
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