Date Error with Windows 7

[David W. Fenton]

I did what you said and got this error
Error Number 463
Description: Class not registered on local machine
Regards Bob

Which line of code as highlighted as producing that error?

 

[Bob Vance]

Which line of code as highlighted as producing that error?

Thanks David, I am getting no error on Debug only when I go to use this code
do I get that error (463) message pop up
------------------------------------------
Private Sub SendMailButton_Click()

On Error GoTo ErrorHandler
If Me.Dirty = True Then
Me.Dirty = False
Dim myfile1 As String, myfile2 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 & "Invoice.pdf"
Case "WORD"
strFormat = acFormatRTF
myfile1 = mydir & "Statement.rtf"
myfile2 = mydir & "Invoice.rtf"

Case "SNAPSHOT"
strFormat = acFormatSNP
myfile1 = mydir & "Statement.SNP"
myfile2 = mydir & "Invoice.SNP"

Case "TEXT"
strFormat = acFormatTXT
myfile1 = mydir & "Statement.txt"
myfile2 = mydir & "Invoice.txt"

Case "HTML"
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

Case Else ' catch all others
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

End Select

Select Case Me.OpenArgs

Case "OwnerStatement"

sndReport = "rptOwnerPaymentMethod"


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("[OwnerLastName]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " Owner")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement, 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 mytot > 0 Then
DoCmd.OutputTo acOutputReport, "rptInvoiceModify",
strFormat, myfile2, False
End If

CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID, dbFailOnError
Dim myitem As Object
Dim myout As Object
Set myout = CreateObject(Outlook.Application, "localhost")
Set myitem = myout.CreateItem(olMailItem)

With myitem
.To = strMail
.CC = Nz(DLookup("EmailCC", "tblOwnerInfo", "OwnerID = " & lngID), "")
.Bcc = Nz(DLookup("EmailBCC", "tblOwnerInfo", "OwnerID = " & lngID), "")
.Subject = "Your Statement" & " / " & Nz(DLookup("[CompanyName]",
"tblCompanyInfo"))
.Body = strBodyMsg 'EditMessage:=blEditMail
.Attachments.Add myfile1
If mytot > 0 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 Sub
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

 

[David W. Fenton]

Thanks David, I am getting no error on D

Turn off your error handler and re-run the code. That will highlight
the offending line of code.

Without that, there is no way for anyone to help you at all --
nobody is going to go through and guess which line of code is
producing the error.

 

[Bob Vance]

Turn off your error handler and re-run the code. That will highlight
the offending line of code.

Without that, there is no way for anyone to help you at all --
nobody is going to go through and guess which line of code is
producing the error.

Thanks David
The Highlighted row was:
Set myout = CreateObject(Outlook.Application, "localhost")
Regards Bob



CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID, dbFailOnError
Dim myitem As Object
Dim myout As Object
Set myout = CreateObject(Outlook.Application, "localhost")
'Set myitem = myout.CreateItem(olMailItem)
Set myitem = myout.CreateItem(0)

 

[Douglas J. Steele]

I believe you need

Set myout = CreateObject("Outlook.Application", "localhost")

although the following may suffice:

Set myout = CreateObject("Outlook.Application")

 

[David W. Fenton]

The Highlighted row was:
Set myout = CreateObject(Outlook.Application, "localhost")

As you reported earlier, the error was:

Doug suggested you try removing the "localhost" (it shouldn't make a
difference, as that's the default, but if you leave it out, it can
be blocked by some security software).

The message is not believable, given that you had previously used
early binding, with a reference to Outlook, right?

Try repairing your Office installation and trying again.

Also, did you fix the olMailItem problem? The line of code
immediately after the offending line in the code you posted has a
reference to that constant, which will be undefined without the
reference (unless you redefined it yourself). I know it's not the
highlighted line, but it's worth a try. Of course, it should give
you a compile error instead of a runtime error. You *do* compile
your code, right?

 

[David W. Fenton]

I believe you need

Set myout = CreateObject("Outlook.Application", "localhost")

although the following may suffice:

Set myout = CreateObject("Outlook.Application")

The first makes explicit what is already the default (and optional)
parameter for CreateObject. I have discovered that leaving it out
can cause automation to be blocked by certain security software,
while supplying it explicitly results in it working. Why this is so,
I can't imagine, since I'd assume code running with a default
parameter defined and with the default parameter undefined would be
exactly the same when it passes by the security software, but
apparently not!

 

[Douglas J. Steele]

Note that he's missing the quotes around "Outlook.Application"

 

[Bob Vance]

As you reported earlier, the error was:


Doug suggested you try removing the "localhost" (it shouldn't make a
difference, as that's the default, but if you leave it out, it can
be blocked by some security software).

The message is not believable, given that you had previously used
early binding, with a reference to Outlook, right?

Try repairing your Office installation and trying again.

Also, did you fix the olMailItem problem? The line of code
immediately after the offending line in the code you posted has a
reference to that constant, which will be undefined without the
reference (unless you redefined it yourself). I know it's not the
highlighted line, but it's worth a try. Of course, it should give
you a compile error instead of a runtime error. You *do* compile
your code, right?

Thanks David, I am not getting any error messages and my 2 reports are going
to my Local Directory but not going to Outlook!

Private Sub SendMailButton_Click()

'On Error GoTo ErrorHandler
If Me.Dirty = True Then
Me.Dirty = False
Dim myfile1 As String, myfile2 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 & "Invoice.pdf"
Case "WORD"
strFormat = acFormatRTF
myfile1 = mydir & "Statement.rtf"
myfile2 = mydir & "Invoice.rtf"

Case "SNAPSHOT"
strFormat = acFormatSNP
myfile1 = mydir & "Statement.SNP"
myfile2 = mydir & "Invoice.SNP"

Case "TEXT"
strFormat = acFormatTXT
myfile1 = mydir & "Statement.txt"
myfile2 = mydir & "Invoice.txt"

Case "HTML"
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

Case Else ' catch all others
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

End Select

Select Case Me.OpenArgs

Case "OwnerStatement"

sndReport = "rptOwnerPaymentMethod"


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("[OwnerLastName]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " Owner")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement, 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 mytot > 0 Then
DoCmd.OutputTo acOutputReport, "rptInvoiceModify",
strFormat, myfile2, False
End If

CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID, dbFailOnError
Dim myitem As Object
Dim myout As Object
'Set myout = CreateObject("Outlook.Application", "localhost")
Set myout = CreateObject("Outlook.Application")
'Set myitem = myout.CreateItem(olMailItem)
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" & " / " & Nz(DLookup("[CompanyName]",
"tblCompanyInfo"))
.Body = strBodyMsg 'EditMessage:=blEditMail
.Attachments.Add myfile1
If mytot > 0 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 Sub
'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

 

[David W. Fenton]

Note that he's missing the quotes around "Outlook.Application"

Hmm. I'd think that wouldn't compile unless you still had the
reference. Of course, if the reference is still there, that would
explain why olMailItem doesn't throw a compile error.

 

[David W. Fenton]

I am not getting any error messages and my 2 reports are going
to my Local Directory but not going to Outlook!

I recall having significant problems with attachments. I think you
have to save the message for it to take, but I could be
misremembering that.

 

[Douglas J. Steele]

You've commented out the .Send command.

--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)

As you reported earlier, the error was:


Doug suggested you try removing the "localhost" (it shouldn't make a
difference, as that's the default, but if you leave it out, it can
be blocked by some security software).

The message is not believable, given that you had previously used
early binding, with a reference to Outlook, right?

Try repairing your Office installation and trying again.

Also, did you fix the olMailItem problem? The line of code
immediately after the offending line in the code you posted has a
reference to that constant, which will be undefined without the
reference (unless you redefined it yourself). I know it's not the
highlighted line, but it's worth a try. Of course, it should give
you a compile error instead of a runtime error. You *do* compile
your code, right?

Thanks David, I am not getting any error messages and my 2 reports are
going to my Local Directory but not going to Outlook!

Private Sub SendMailButton_Click()

'On Error GoTo ErrorHandler
If Me.Dirty = True Then
Me.Dirty = False
Dim myfile1 As String, myfile2 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 & "Invoice.pdf"
Case "WORD"
strFormat = acFormatRTF
myfile1 = mydir & "Statement.rtf"
myfile2 = mydir & "Invoice.rtf"

Case "SNAPSHOT"
strFormat = acFormatSNP
myfile1 = mydir & "Statement.SNP"
myfile2 = mydir & "Invoice.SNP"

Case "TEXT"
strFormat = acFormatTXT
myfile1 = mydir & "Statement.txt"
myfile2 = mydir & "Invoice.txt"

Case "HTML"
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

Case Else ' catch all others
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

End Select

Select Case Me.OpenArgs

Case "OwnerStatement"

sndReport = "rptOwnerPaymentMethod"


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("[OwnerLastName]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " Owner")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement, 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 mytot > 0 Then
DoCmd.OutputTo acOutputReport, "rptInvoiceModify",
strFormat, myfile2, False
End If

CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID, dbFailOnError
Dim myitem As Object
Dim myout As Object
'Set myout = CreateObject("Outlook.Application", "localhost")
Set myout = CreateObject("Outlook.Application")
'Set myitem = myout.CreateItem(olMailItem)
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" & " / " & Nz(DLookup("[CompanyName]",
"tblCompanyInfo"))
.Body = strBodyMsg 'EditMessage:=blEditMail
.Attachments.Add myfile1
If mytot > 0 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 Sub
'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

 

[Bob Vance]

Thanks Douglas, Thats a good reason why it would not send
Thank you very much for your help much appreciated, all good now
Regards Bob

You've commented out the .Send command.

--
Doug Steele, Microsoft Access MVP

(no private e-mails, please)

The Highlighted row was:
Set myout = CreateObject(Outlook.Application, "localhost")

As you reported earlier, the error was:

Error Number 463
Description: Class not registered on local machine

Doug suggested you try removing the "localhost" (it shouldn't make a
difference, as that's the default, but if you leave it out, it can
be blocked by some security software).

The message is not believable, given that you had previously used
early binding, with a reference to Outlook, right?

Try repairing your Office installation and trying again.

Also, did you fix the olMailItem problem? The line of code
immediately after the offending line in the code you posted has a
reference to that constant, which will be undefined without the
reference (unless you redefined it yourself). I know it's not the
highlighted line, but it's worth a try. Of course, it should give
you a compile error instead of a runtime error. You *do* compile
your code, right?

Thanks David, I am not getting any error messages and my 2 reports are
going to my Local Directory but not going to Outlook!

Private Sub SendMailButton_Click()

'On Error GoTo ErrorHandler
If Me.Dirty = True Then
Me.Dirty = False
Dim myfile1 As String, myfile2 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 & "Invoice.pdf"
Case "WORD"
strFormat = acFormatRTF
myfile1 = mydir & "Statement.rtf"
myfile2 = mydir & "Invoice.rtf"

Case "SNAPSHOT"
strFormat = acFormatSNP
myfile1 = mydir & "Statement.SNP"
myfile2 = mydir & "Invoice.SNP"

Case "TEXT"
strFormat = acFormatTXT
myfile1 = mydir & "Statement.txt"
myfile2 = mydir & "Invoice.txt"

Case "HTML"
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

Case Else ' catch all others
strFormat = acFormatHTML
myfile1 = mydir & "Statement.htm"
myfile2 = mydir & "Invoice.htm"

End Select

Select Case Me.OpenArgs

Case "OwnerStatement"

sndReport = "rptOwnerPaymentMethod"


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("[OwnerLastName]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " Owner")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement, 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 mytot > 0 Then
DoCmd.OutputTo acOutputReport, "rptInvoiceModify",
strFormat, myfile2, False
End If

CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID, dbFailOnError
Dim myitem As Object
Dim myout As Object
'Set myout = CreateObject("Outlook.Application", "localhost")
Set myout = CreateObject("Outlook.Application")
'Set myitem = myout.CreateItem(olMailItem)
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" & " / " & Nz(DLookup("[CompanyName]",
"tblCompanyInfo"))
.Body = strBodyMsg 'EditMessage:=blEditMail
.Attachments.Add myfile1
If mytot > 0 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 Sub
'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

 

[Bob Vance]

Thanks Douglas, Thats a good reason why it would not send
Thank you very much for your help much appreciated, all good now
Regards Bob

news:[email protected]...

One More thing should I keep all my 7 References?........Regards Bob

Visual Basic For Application
Microsoft Access 12.0 Object Library
OLE Automation
Microsoft ActiveX Data Objects 2.1 Library
Microsoft Visual Basic for Application Extensilbilty 5.3
Microsoft Outlook 12 Object Library
Microsoft Office 12.0 Access database engine Object Library

 

[Douglas J. Steele]

I believe David & I both suggested that you should only require 3
references:

- Visual Basic For Application
- Microsoft Access 12.0 Object Library
- Microsoft Office 12.0 Access database engine Object Library

A large part of this thread involved getting late binding to work with
Outlook so that you could remove the reference to Microsoft Outlook 12
Object Library.

We both suggested you use DAO rather than ADO, in which case the reference
to Microsoft ActiveX Data Objects 2.1 Library won't be required.

There's seldom a reason for a reference to either OLE Automation or
Microsoft Visual Basic for Application Extensilbilty 5.3

 

[Bob Vance]

Thanks Douglas, So now I must re code my funGetHorse as its ADODB?
Regards Bob

Function funGetHorse(Optional lngInvoiceID As Long = 0, Optional lngHorseID
As Long = 0, Optional bHorse As Boolean = False) As Variant

Dim recHorseID As New ADODB.Recordset, strAge As String, strName As String
Dim recHorseName As New ADODB.Recordset

If lngHorseID = 0 And lngInvoiceID = 0 Then
funGetHorse = ""
Exit Function
End If

If lngHorseID = 0 Then
recHorseID.Open "SELECT HorseID FROM tblInvoice WHERE InvoiceID=" _
& lngInvoiceID, CurrentProject.Connection, adOpenDynamic,
adLockOptimistic

If recHorseID.EOF = True And recHorseID.BOF = True Then
Set recHorseID = Nothing
funGetHorse = ""
Exit Function
End If
lngHorseID = recHorseID.Fields("HorseID")
End If

recHorseName.Open "SELECT * FROM tblHorseInfo WHERE HorseID=" _
& lngHorseID, CurrentProject.Connection, adOpenDynamic, adLockOptimistic

If recHorseName.EOF = True And recHorseName.BOF = True Then
Set recHorseName = Nothing
funGetHorse = ""
Exit Function
End If

If IsNull(recHorseName.Fields("HorseName")) Or
recHorseName.Fields("HorseName") = "" Then

'If flg is true and Horse Name is null then Horse Name is set as
blank.
If bHorse = False Then
If IsNull(recHorseName.Fields("DateOfBirth")) Or
recHorseName.Fields("DateOfBirth") = "" Then
strAge = "0yo"
Else
strAge = funCalcAge(Format(CDate("01-Aug-" &
recHorseName.Fields("DateOfBirth")), "dd-mmm-yyyy"), Format(Now(),
"dd-mmm-yyyy"), 1)
End If
strName = Nz(recHorseName.Fields("FatherName"), "") & " -- " &
Nz(recHorseName.Fields("MotherName"), "") _
& " " & strAge & " " & Nz(recHorseName.Fields("Sex"), "")

Else
strName = ""
End If
Else
strName = recHorseName.Fields("HorseName")
End If

Set recHorseID = Nothing
Set recHorseName = Nothing
funGetHorse = strName
End Function

Public Function AgeByBirthDate(dtBirthDate As Date, Optional AgeBy As String
= "d", _
Optional AgeAtBirth As Integer = 0) As Integer

'Last updated 13/10/06
'Output: caculate age by date of bitrh


'AdeBy: "d" ,"m","y" Change age on the day, month or year of Date of
Birth respectively
'if not d , m ,or y calculate by year

'Age at birth: whether age counting starts from 0 or from 1
Dim tmpAge As Integer, tmpDate As Date, DOB As Integer, MoB As Integer,
YoB As Integer

tmpDate = dtBirthDate
DOB = Day(tmpDate) 'Day (of the month) of birth = 1-31
MoB = Month(tmpDate) 'Month of Birth = 1-12
YoB = Year(tmpDate) 'Year of birth (100 -9999)

If IsMissing(AgeBy) Or Len(AgeBy) = 0 Then
AgeBy = "y" 'Default to age by year
End If

If IsMissing(AgeAtBirth) Then
AgeAtBirth = 0 'Default to atart counting at 0
End If

tmpAge = Year(Date) - YoB + AgeAtBirth

Select Case AgeBy

Case "m" 'age on the month of birth
tmpAge = tmpAge - IIf(Month(Date) < Month(DOB), 1, 0)

Case "d" 'Age on the aniversary of birth
If Month(Date) < MoB Or (Month(Date) = MoB And Day(Date) < DOB)
Then
tmpAge = tmpAge - 1
End If

'leap year test
'if born on 29 Feb and today is 28 Feb in a non leap year -
celebrate on 28 feb

' No need to calculat years, tmpAge is alraedy the age
End Select

AgeByBirthDate = tmpAge

End Function

 

[Douglas J. Steele]

Function funGetHorse(Optional lngInvoiceID As Long = 0, _
Optional lngHorseID As Long = 0, _
Optional bHorse As Boolean = False) As Variant

On Error GoTo ErrorHandler

Dim recHorseID As DAO.Recordset
Dim recHorseName As DAO.Recordset
Dim strAge As String, strName As String

If lngHorseID = 0 And lngInvoiceID = 0 Then
funGetHorse = ""
Exit Function
End If

If lngHorseID = 0 Then
Set recHorseID = CurrentDb.OpenRecordset( _
"SELECT HorseID FROM tblInvoice WHERE InvoiceID=" & lngInvoiceID)
If recHorseID.EOF = True And recHorseID.BOF = True Then
recHorseID.Close
Set recHorseID = Nothing
funGetHorse = ""
Exit Function
End If
lngHorseID = recHorseID.Fields("HorseID")
End If

Set recHorseName = CurrentDb.OpenRecordset( _
"SELECT * FROM tblHorseInfo WHERE HorseID=" & lngHorseID)
If recHorseName.EOF = True And recHorseName.BOF = True Then
recHorseName.Close
Set recHorseName = Nothing
funGetHorse = ""
Exit Function
End If

If IsNull(recHorseName.Fields("HorseName")) Or _
recHorseName.Fields("HorseName") = "" Then

'If flg is true and Horse Name is null then Horse Name is set as blank.
If bHorse = False Then
If IsNull(recHorseName.Fields("DateOfBirth")) Or _
recHorseName.Fields("DateOfBirth") = "" Then
strAge = "0yo"
Else
strAge = funCalcAge(Format(CDate("01-Aug-" & _
recHorseName.Fields("DateOfBirth")), "dd-mmm-yyyy"), _
Format(Now(), "dd-mmm-yyyy"), 1)
End If
strName = Nz(recHorseName.Fields("FatherName"), "") & " -- " & _
Nz(recHorseName.Fields("MotherName"), "") & _
" " & strAge & " " & Nz(recHorseName.Fields("Sex"), "")
Else
strName = ""
End If
Else
strName = recHorseName.Fields("HorseName")
End If

ExitHere:
On Error Resume Next
recHorseID.Close
Set recHorseID = Nothing
recHorseName.Close
Set recHorseName = Nothing
funGetHorse = strName
Exit Function

ErrorHandler:
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere

End Function

 

[David W. Fenton]

So now I must re code my funGetHorse as its ADODB?

There is nothing in either of those functions that depends on any
functionality of ADO that is unique to ADO. Why did you implement it
in ADO instead of just keeping with DAO?

 

[Bob Vance]

Thanks Dougles, but I just did a search on ADODB.Recordset in my db and have
174 entries, how do I go about changing them all to DAO.Recordset?
Thanks for your help..........Bob
Example Below:
-------------------------------------------------------------------
Private Sub Form_Load()
Set cnnStableAccount = CurrentProject.Connection
CurrentDb.Execute "update tblAdminSetup set MailFlag = " & True
DoCmd.Maximize
End Sub


'Code TO Distribute Charges Into Owners
Private Sub subSetInvoiceValues()

Dim recInvoice As ADODB.Recordset
Set recInvoice = New ADODB.Recordset
Dim recInvoice_ItMdt As ADODB.Recordset
Set recInvoice_ItMdt = New ADODB.Recordset
Set recInvoice = New ADODB.Recordset
Dim lngInvoiceID As Long
Dim lngInvoiceNo As Long
Dim lngIntermediateID As Long
recInvoice_ItMdt.Open "Select * from tblInvoice_ItMdt;",
CurrentProject.Connection, adOpenDynamic, adLockOptimistic

recInvoice.Open "Select * from tblInvoice;", CurrentProject.Connection,
adOpenDynamic, adLockOptimistic
lngInvoiceID = Nz(DMax("InvoiceID", "tblInvoice"), 1) + 1

lngInvoiceNo = Nz(DMax("InvoiceNo", "tblInvoice"), 1) + 1


If recInvoice.BOF = False And recInvoice.EOF = False Then
recInvoice.MoveLast
End If

recInvoice.AddNew
Dim lngItMdt As Long
If recInvoice_ItMdt.BOF = False And recInvoice_ItMdt.EOF = False Then
lngItMdt = recInvoice_ItMdt.Fields("IntermediateID")
End If
Do While Not recInvoice_ItMdt.EOF = True
lngIntermediateID = recInvoice_ItMdt.Fields("IntermediateID")

With recInvoice


Dim recHorseOwners As New ADODB.Recordset, curOwnerPercentAmount As
Currency
Dim curTotal As Currency, curGSTContentsValue As Currency

recHorseOwners.Open "SELECT OwnerID,OwnerPercent FROM
tblHorseDetails" _
& " WHERE HorseID=" _
& Nz(val(recInvoice_ItMdt.Fields("HorseID")), 0) _
& " AND OwnerID > 0 AND Invoicing = False ORDER BY OwnerID ",
CurrentProject.Connection, adOpenDynamic, adLockOptimistic

If recHorseOwners.EOF = True And recHorseOwners.BOF = True Then
recHorseOwners.Close
Set recHorseOwners = Nothing
MsgBox "This Horse Has No Owner At ALL.", vbApplicationModal +
vbOKOnly + vbInformation

.Fields("InvoiceID") = lngInvoiceID
.Fields("HorseID") = Nz(val(recInvoice_ItMdt.Fields("HorseID")),
0)
.Fields("HorseName") = Nz(recInvoice_ItMdt.Fields("HorseName"),
"")
.Fields("FatherName") =
Nz(recInvoice_ItMdt.Fields("FatherName"), "")
.Fields("MotherName") =
Nz(recInvoice_ItMdt.Fields("MotherName"), "")

.Fields("DateOfBirth") =
Format(CDate(recInvoice_ItMdt.Fields("DateOfBirth")), "mm/dd/yyyy")

.Fields("HorseDetailInfo") =
recInvoice_ItMdt.Fields("FatherName") _
& "--" & recInvoice_ItMdt.Fields("MotherName") & "--" _
& funCalcAge(Format(recInvoice_ItMdt.Fields("DateOfBirth") _
, "dd-mmm-yyyy"), Format("01-Aug-" & Year(Now()),
"dd-mmm-yyyy"), 1) _
& "-" & recInvoice_ItMdt.Fields("Sex")

.Fields("Sex") = recInvoice_ItMdt.Fields("Sex")
.Fields("GSTOptionsText") =
Nz(recInvoice_ItMdt.Fields("GSTOptionsText"), 0)
.Fields("GSTOptionsValue") =
Nz(recInvoice_ItMdt.Fields("GSTOptionsValue"), 0)
.Fields("SubTotal") = Nz(recInvoice_ItMdt.Fields("SubTotal"), 0)
.Fields("TotalAmount") =
Nz(recInvoice_ItMdt.Fields("TotalAmount"), 0)
.Fields("InvoiceDate") = Format(Now(), "dd/mm/yyyy")
End If
recHorseOwners.MoveFirst
Do Until recHorseOwners.EOF = True

If lngIntermediateID > lngItMdt Then
.AddNew
lngInvoiceID = lngInvoiceID + 1
lngInvoiceNo = lngInvoiceNo + 1
lngItMdt = lngIntermediateID
End If
Dim recOwnersInfo As New ADODB.Recordset


recOwnersInfpen "SELECT OwnerID," _
&
"IIf(isnull(tblOwnerInfwnerTitle),'',tblOwnerInfwnerTitle & ' ')" _
& " & IIf(isnull(tblOwnerInfwnerLastName),'
',tblOwnerInfwnerLastName & ', ')" _
& " &
IIf(isnull(tblOwnerInfwnerFirstName),'',tblOwnerInfwnerFirstName) AS
Name " _
& ",OwnerAddress " _
& "FROM tblOwnerInfo WHERE OwnerID=" _
& val(recHorseOwners.Fields("OwnerID")) _
, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
If recOwnersInfo.EOF = True And recOwnersInfo.BOF = True Then
recOwnersInfo.Close
Set recOwnersInfo = Nothing
Else
'
curTotal = DSum("TotalAmount", "tblInvoice_ItMdt",
"HorseID=" _
& Nz(recInvoice_ItMdt.Fields("HorseID"), 0))
curOwnerPercentAmount = IIf(recHorseOwners.Fields _
("OwnerPercent") = "" Or _
IsNull(recHorseOwners.Fields("OwnerPercent")), 0,
Format(curTotal, "#0.00") _
* recHorseOwners.Fields("OwnerPercent"))

.Fields("OwnerID") = recOwnersInfo.Fields("OwnerID")


.Fields("OwnerName") = recOwnersInfo.Fields("Name")


.Fields("OwnerAddress") =
recOwnersInfo.Fields("OwnerAddress")
.Fields("OwnerPercent") = IIf(recHorseOwners.Fields _
("OwnerPercent") = "" Or IsNull(recHorseOwners.Fields _
("OwnerPercent")), 0, recHorseOwners.Fields("OwnerPercent"))

.Fields("OwnerPercentAmount") =
Format(curOwnerPercentAmount, "#0.00")

curGSTContentsValue = (Format(curOwnerPercentAmount,
"#0.00") / 9)
.Fields("GSTContentsValue") = Format(curGSTContentsValue,
"#0.00")

If Format(curGSTContentsValue, "#0.00") > 0 Then
.Fields("GSTContentsText") = "Tax Contents"
ElseIf Format(curGSTContentsValue, "#0.00") < 0 Then
.Fields("GSTContentsText") = "Credit"
Else
.Fields("GSTContentsText") = ""
End If
End If
recOwnersInfo.Close
Set recOwnersInfo = Nothing

.Fields("InvoiceNo") = lngInvoiceNo


.Fields("InvoiceID") = lngInvoiceID
.Fields("HorseID") = recInvoice_ItMdt.Fields("HorseID")
.Fields("HorseName") = recInvoice_ItMdt.Fields("HorseName")
.Fields("FatherName") = recInvoice_ItMdt.Fields("FatherName")
.Fields("MotherName") = recInvoice_ItMdt.Fields("MotherName")
.Fields("DateOfBirth") =
Format(CDate(Nz(recInvoice_ItMdt.Fields("DateOfBirth"), 0)), "mm/dd/yyyy")

.Fields("HorseDetailInfo") =
recInvoice_ItMdt.Fields("FatherName") _
& "--" & recInvoice_ItMdt.Fields("MotherName") & "--" _
& funCalcAge(Format(Nz(recInvoice_ItMdt.Fields("DateOfBirth"),
0) _
, "dd-mmm-yyyy"), Format("01-Aug-" & Year(Now()),
"dd-mmm-yyyy"), 1) _
& "-" & recInvoice_ItMdt.Fields("Sex")

.Fields("Sex") = recInvoice_ItMdt.Fields("Sex")
.Fields("GSTOptionsText") =
Nz(recInvoice_ItMdt.Fields("GSTOptionsText"), 0)
.Fields("GSTOptionsValue") =
Nz(recInvoice_ItMdt.Fields("GSTOptionsValue"), 0)
.Fields("SubTotal") = Nz(recInvoice_ItMdt.Fields("SubTotal"), 0)
.Fields("TotalAmount") =
Nz(recInvoice_ItMdt.Fields("TotalAmount"), 0)
.Fields("InvoiceDate") = Format(Now(), "dd/mm/yyyy")


Application.SysCmd acSysCmdSetStatus, "Invoice No=" &
..Fields("InvoiceNo") _
& " Horse Name=" & .Fields("HorseName") & " Owner Name=" _
& .Fields("OwnerName")

funSetInvoiceDetailValues lngIntermediateID, lngInvoiceID,
lngInvoiceNo
.Fields("CompanyID") = DLookup("CompanyID", "tblCompanyInfo")
recInvoice.Update
.Requery
recHorseOwners.MoveNext
If recHorseOwners.EOF = False Then
.AddNew
lngInvoiceID = lngInvoiceID + 1
lngInvoiceNo = lngInvoiceNo + 1

End If
Loop
.Update
End With
CurrentProject.Connection.Execute "Delete * from tblAddition_ItMdt where
IntermediateID=" _
& lngIntermediateID

CurrentProject.Connection.Execute "Delete * from tblDaily_ItMdt where
IntermediateID=" _
& lngIntermediateID

recHorseOwners.Close
recInvoice_ItMdt.MoveNext
Loop

Set recHorseOwners = Nothing

CurrentProject.Connection.Execute "Delete * from tblInvoice_ItMdt;"
[Forms]![frmMain]![subfrmDisList].Form!lstModify.Requery

End Sub

 

[Douglas J. Steele]

Unfortunately, it's not just a global change. You're going to have to change
how you instantiate each recordset manually, using a technique such as I
showed in the example I gave you.