-
I have a function that calculates the age of someone. The problem is that I am using a database with about 6000 records and each record goes through this process and really slows down the record retrieving process. Is there any way I can speed this process up? I thought about using a statement in SQL, but I havn't found anything yet.
Thanks
Public Sub RetrieveDebtors(ClientId as String)
Dim lstItem as ListItem
Dim intItem as Integer
Dim intCount as Integer
'Retrieves the count of records to be accessed
Set recDebtors = dbsData.OpenRecordset("SELECT COUNT(*)" & _
" AS intCount FROM Debtors WHERE ClientId = '" & _
ClientId & "'")
intCount = recDebtors!intCount
'Retrieves the records
Set recDebtors = dbsData.OpenRecordset("SELECT * FROM " & _
Debtors WHERE ClientId= '" & strDebtorId & _
"' ORDER BY DebtorId DESC")
'Adds the items to the list
For intItem = 1 To intCount
Set lstItem = vewNotes.ListItems.Add()
With lstItem
.SmallIcon = 1
.Key = recDebtors!Id
.Text = FullName(recDebtors!First, recDebtors!Last)
.SubItems(1) = recDebtors!Birthdate
.SubItems(2) = Age(recdebtor!Birthdate)
End With
recNotes.MoveNext
Next
End Sub()
Private Function Age(ByVal strBirth As Date) As Integer
Dim intYear As Integer
Dim strCurrent As String
Dim datBirth As Date
datBirth = CDate(strBirth)
If datBirth <= Date Then 'Date selected is less
'than current date
strCurrent = Format(Date, "mm/dd")
strBirth = Format(strBirth, "mm/dd")
intYear = Year(Date) - Year(cboBirthday)
'Determines is month and day of birth has exceeded
'the current month and day
If strCurrent < strBirth Then
'Current month and day has not reached the
'birth month and day
intYear = intYear - 1
End If
Else 'Date selected is greater than current date
MsgBox "The birthdate selected is greater " & _
"than the current date.", vbInformation, "Birthdate"
intYear = 0
End If
Age = intYear 'Returns the age
End Function
-
Use this code from Wayne to calculate a person's age, I think it's easier to see :)
Code:
'[begin of code]
'Author: Wayne
'Origin:
'Purpose: Calculate a persons age
'Version: VB5+
Option Explicit
Public Function GetAge(DateString As String) As Integer
Dim lDate As Date
lDate = Left$(DateString, 2) + "/" + Mid$(DateString, 3, 2) _
+ "/" + Right$(DateString, 4)
GetAge = DateDiff("yyyy", lDate, Now)
End Function
'Usage
Private Sub Command1_Click()
'use your birthday in this format mmddyyyy
Dim x As String 'this is your birthday var
x = 12301970 'value
MsgBox GetAge(x) 'call function
End Sub
'[end of code]
And to speed things up, don't add them to a list, but to an Array
-
Any particular reason you can't calculate the age in the select SQL?
sql = "SELECT *,int((Now() - Debtors!Birthdate)/365.25) as AGE" _
sql = sql & " FROM Debtors"
sql = sql & " WHERE ClientId= '" & strDebtorId & _
"' ORDER BY DebtorId DESC"
Set recDebtors = dbsData.OpenRecordset(sql)
I'm not sure about the exact syntax, but I've done similar things in the past.
Good Luck
DerFarm
-
Inaccurate Age
I tried to use that, but that code doesn't calculate the correct age all of the time. For example, if todays date is 6/22/2000:
Code:
datBirth = #6/23/1998#
intYear = DateDiff("yyyy", datBirth, Now)
Retruns 2, but...
Code:
datBirth = #6/21/1998#
intYear = DateDiff("yyyy", datBirth, Now)
Also returns 2, but should return 1 because the date has not been reached yet.
There needs to be a seperate statement to determine if that date has been reach such as:
Code:
strBirth = Format(strBirth, "mm/dd")
strCurrent = Format(#6/22/2000#, "mm/dd")
If strCurrent < strBirth Then
'Current month and day has not reached the
'birth month and day
intYear = intYear - 1 'Take the year away
End If
This code will give you the correct age to the month and day
-
Yeah, the int function will round on you. Thus if xxx/yyy = z.q where q >=.5 you'll get int(xxx/yyy) = Z+1...Not what I like but there it is.
Try using trunc() instead, that just cuts off the decimals.
Good Luck
DerFarm
-
SQL Age Calculation
I created a complicated SQL statement that works!
Code:
Dim intCount as Integer
Dim lstItem as ListItem
Dim intItem as Integer
Set recDebtors = dbsData.OpenRecordset("SELECT " & _
"COUNT(*) AS intCount"
intCount = recDebtors!intCount
Set recDebtors = dbsData.OpenRecordset("SELECT *, " & _
"DateDiff('yyyy',[Birthday],Date())-[intPassed] " & _
"AS intAge, Int(Format([Birthday],'mm/dd')<" & _
"Format(Date()+1,'mm/dd'))+1 AS intPassed FROM Debtors")
'Adds the items to the list
For intItem = 1 To intCount
Set lstItem = vewNotes.ListItems.Add()
With lstItem
.SmallIcon = 1
.Key = recDebtors!Id
.Text = FullName(recDebtors!First, recDebtors!Last)
.SubItems(1) = recDebtors!Birthday
.SubItems(2) = "Age: " & intAge
End With
recDebtors.MoveNext
Next
This code returns:
1) All debtor information
2) Debtor's age, intAge
3) If the month and day has passed, intPassed
4) The count of records accessed, intCount
This makes my code extremely faster! And it automatically takes away 1 if intPassed = True.
If anyone can find a way to combine those 2 SQL statement and return the same results, great!
