Having Trouble Returning Array from Function

[NigelS]

I am using the following code to test a Function which will return a fixed number of data values from a Table recordset.



However when I run the Test() which calls the Function in question passing some test data, I get the error message: "runtime error 3420. Object invalid or no longer set". I am sure I am doing something really stupid but I can't pin down what is wrong (not an expert user!).

Can anyone help?

======================

Function Test()
Dim PreviousTenancy() As Variant, i As Integer
PreviousTenancy = Get_Previous_Tenancy("11FOS5", "000355")
For i = 0 To 1
MsgBox PreviousTenancy(i)
Next i
End Function


Function Get_Previous_Tenancy(nPropRef As String, nCurrentAccRef As String) As Variant()
Dim dbs As Database, xTenancy As Recordset, nSQL As String
Set dbs = CurrentDb()
nSQL = "SELECT Property.PRef, Property.PAddress1, Rent_Book.AccRef, Rent_Book.TenancyStart, Tenants.TName " & _
"FROM (Property INNER JOIN Rent_Book ON Property.PRef = Rent_Book.PRef) INNER JOIN Tenants ON " & _
"Rent_Book.AccRef = Tenants.AccRef WHERE (((Property.PRef)='" & nPropRef & "'));"

Set xTenancy = dbs.OpenRecordset(nSQL)

If xTenancy.EOF Then GoTo nExit
xTenancy.MoveFirst
Do Until xTenancy!AccRef = nCurrentAccRef: xTenancy.MoveNext: Loop
If xTenancy.RecordCount = 1 Then MsgBox "No Earlier Tenancy Exists": GoTo nExit
xTenancy.MovePrevious

Get_Previous_Tenancy = Array(xTenancy!AccRef, xTenancy!TenancyStart)

nExit:
xTenancy.Close

End Function

[RuralGuy]

Maybe you should look into a different approach: http://allenbrowne.com/ser-16.html

[NigelS]

Thanks for your response. Taking a lead from the link you gave I extended my code (below). However, as far as I can see the function has to be called three times in order to access all three data elements, not exactly efficient or elegant as passing the data in one go via an array. Surely this must be possible?

NigelS

============================

Public Type PrevTenancyData
pStartDate As Date
pTName As String
pTenancyAccRef As String
End Type

Function Test()
MsgBox Get_Previous_Tenancy("11FOS5", "000355").pStartDate
MsgBox Get_Previous_Tenancy("11FOS5", "000355").pTenancyAccRef
MsgBox Get_Previous_Tenancy("11FOS5", "000355").pTName
End Function

Function Get_Previous_Tenancy(nPropRef As String, nCurrentAccRef As String) As PrevTenancyData
Dim dbs As Database, xTenancy As Recordset, nSQL As String
Set dbs = CurrentDb()
nSQL = "SELECT Property.PRef, Property.PAddress1, Rent_Book.AccRef, Rent_Book.TenancyStart, Tenants.TName " & _
"FROM (Property INNER JOIN Rent_Book ON Property.PRef = Rent_Book.PRef) INNER JOIN Tenants ON " & _
"Rent_Book.AccRef = Tenants.AccRef WHERE (((Property.PRef)='" & nPropRef & "'));"

Set xTenancy = dbs.OpenRecordset(nSQL)

If xTenancy.EOF Then GoTo nExit
xTenancy.MoveFirst
Do Until xTenancy!AccRef = nCurrentAccRef: xTenancy.MoveNext: Loop
If xTenancy.RecordCount = 1 Then MsgBox "No Earlier Tenancy Exists": GoTo nExit
xTenancy.MovePrevious

Get_Previous_Tenancy.pStartDate = xTenancy!TenancyStart
Get_Previous_Tenancy.pTenancyAccRef = xTenancy!AccRef
Get_Previous_Tenancy.pTName = xTenancy!TName
nExit:
xTenancy.Close

End Function

[RuralGuy]

Hmm...I didn't see anything in the link to suggest you could not have an array in your DataType.

[NigelS]

OK, well my final code looks like this (below). I restructured the function to fill an external public array instead or returning any data and then used the contents of the array in my external code. Does what I wanted originally.

=======================

Public PrevTenancyData(4) As Variant

Function Test()
Dim nPRef As String, nAccRef As String, X As Integer
nPRef = "11FOS5": nAccRef = "000355"
If Not Get_Previous_Tenancy(nPRef, nAccRef) Then MsgBox "No Previous Tenancy Exists": Exit Function
End Function

Function Get_Previous_Tenancy(nPropRef As String, nCurrentAccRef As String) As Boolean
Dim dbs As Database, xTenancy As Recordset, nSQL As String
Set dbs = CurrentDb()
nSQL = "SELECT Property.PRef, Property.PAddress1, Rent_Book.AccRef, Rent_Book.TenancyStart, TName, " & _
"LTrim(FAddress1) & ', ' & LTrim(FAddress2) & ', ' & LTrim(FAddress3) & ', ' & LTrim(FPostcode) " & _
"AS FwdAddress, KeysReturnDate FROM (Property INNER JOIN Rent_Book ON Property.PRef = Rent_Book.PRef) " & _
"INNER JOIN Tenants ON Rent_Book.AccRef = Tenants.AccRef WHERE (((Property.PRef)='" & nPropRef & "'));"

Set xTenancy = dbs.OpenRecordset(nSQL)

xTenancy.MoveFirst
Do Until xTenancy!AccRef = nCurrentAccRef: xTenancy.MoveNext: Loop

If xTenancy.RecordCount = 1 Then GoTo nExit ' No Previous Tenancy Exists

Get_Previous_Tenancy = True
xTenancy.MovePrevious
PrevTenancyData(0) = xTenancy!TenancyStart
PrevTenancyData(1) = xTenancy!AccRef
PrevTenancyData(2) = xTenancy!TName
PrevTenancyData(3) = xTenancy!FwdAddress
PrevTenancyData(4) = xTenancy!KeysReturnDate
nExit:
xTenancy.Close

End Function

[RuralGuy]

That's great! Thanks for sharing. You may want to release all of your Set Objects. Are you ready to use the Thread Tools and mark this thread as Solved?

[NigelS]

That's great! Thanks for sharing. You may want to release all of your Set Objects.

Don't they get released automatically when you exit the function? If not how to release & what are consequences of not doing so?

NigelS

[RuralGuy]

Unfortunately, not always. That is why most developers *always* Set Var = Nothing for every Var Set in the procedure.

[NigelS]

Unfortunately, not always. That is why most developers *always* Set Var = Nothing for every Var Set in the procedure.

OK thanks, you learn something new every day!

NigelS