Using GetRows

  • Thread starter Thread starter Bob
  • Start date Start date
B

Bob

Access Version 2002

I am desiging a routiene that will check development database lookup
tables for records proir to pushing them out to production. I would
normally loop through a recordset loading the array (after re-
diming). I thought I'd try GetRows, but am having difficulty and not
much luck. The routiene below only sees one row, when in fact, there
are 13 tables that need to be examined.

Thanks in advance for looking.

Bob

Public Function fuCheckLkupTables() As String
'---------------------------------------------------------------------------------------
' Procedure : fuCheckLkupTables
' Purpose : Examines all lookup tables used in database to ensure
they are not empty.
' Author : Bob
' Phone : xxx-xxx-xxxx
' Email:
' DateTime : 9/15/2008 11:28
' Notes :
' Tables : AllFields
' Forms :
' Calls :
'---------------------------------------------------------------------------------------
'Revision History
'---------------------------------------------------------------------------------------

Dim dbe As DAO.DBEngine
Dim db As DAO.Database
Dim sql As String
Dim rst As DAO.Recordset
Dim strTbl As String
Dim strMsg As String
Dim varValues As Variant
Dim i As Integer
Dim intRowCount As Integer
Dim intFieldCount As Integer
Dim j As Integer

On Error GoTo fuCheckLkupTables_Error

Set dbe = CreateObject("DAO.DBEngine.36")
Set db = CurrentDb()

sql = "SELECT DISTINCT lkuptable " _
& "FROM AllFields " _
& "WHERE lkuptable Is Not Null AND flag=1 AND lkup_col_cnt>0;"

Set rst = db.OpenRecordset(sql, dbOpenSnapshot)

If rst.RecordCount < 1 Then
fuCheckLkupTables = "No lookup tables listed in the AllFields
table."
rst.Close
Set dbe = Nothing
Set db = Nothing
Exit Function
End If

' Otherwise, copy recordset into array.
varValues = rst.GetRows(1)
intFieldCount = UBound(varValues, 1)
intRowCount = UBound(varValues, 2)
rst.Close


For j = 0 To intRowCount
For i = 0 To intFieldCount
strTbl = varValues(0, i)
' Create sql string and determine if records exists.
sql = "SELECT Count(*) AS cnt_" & strTbl & " FROM " &
strTbl & ";"
Set rst = db.OpenRecordset(sql, dbOpenSnapshot)
If rst.RecordCount < 2 Then
strMsg = strMsg & strTbl & " has no lookup records." &
vbCrLf
End If
Next
Next

If Len(strMsg) > 0 Then
fuCheckLkupTables = strMsg
End If


ExitHere:
Set dbe = Nothing
Set db = Nothing
Exit Function

fuCheckLkupTables_Error:

MsgBox "Error " & Err.Number & " (" & Err.description & ") " _
& "in procedure fuCheckLkupTables of Module basCheckLkupTables"

End Function
 
Thanks. I missed what you did not. Yes, it works now.

I found another interesting way to do the same thing (what a surprise)
using MS Srcipting Runtime library and thought I'd share it. It is
nice not to have to size the array, add/delete items, and search it
(case sensitive).

Thanks,
Bob


Public Function fuCheckLkupTables()
'---------------------------------------------------------------------------------------
' Notes : Set reference to Microsoft Scripting Runtime.
'---------------------------------------------------------------------------------------

Dim dbe As DAO.DBEngine
Dim db As DAO.Database
Dim sql As String
Dim rst As DAO.Recordset
Dim strTbl As String
Dim i As Integer
Dim intNumRecs As Integer
Dim dct As New Scripting.Dictionary
Dim varItm As Variant

On Error GoTo fuCheckLkupTables_Error

Set dbe = CreateObject("DAO.DBEngine.36")
Set db = CurrentDb()
i = 0

' Delete and recreate empty temporary table.
TableExist ("t_LkupTblCheck")
sql = "CREATE TABLE t_LkupTblCheck " _
& "(tbl_name TEXT (9), " _
& "num_of_recs long);"
db.Execute sql

' Examine AllFields table where a lookup table is indicated.
sql = "SELECT DISTINCT lkuptable " _
& "FROM AllFields " _
& "WHERE lkuptable Is Not Null AND flag=1 AND lkup_col_cnt>0;"

Set rst = db.OpenRecordset(sql, dbOpenSnapshot)

If rst.RecordCount < 1 Then
fuCheckLkupTables = "No lookup tables listed in the AllFields
table."
rst.Close
Set dbe = Nothing
Set db = Nothing
Exit Function
End If

With rst
Do Until .EOF
strTbl = ![lkuptable]
sql = "SELECT Count(*) AS cnt FROM " & strTbl & ";"
Set rst = db.OpenRecordset(sql, dbOpenSnapshot)
intNumRecs = rst![cnt]

' Ensures duplicate key in dictionary does not exists
If Not dct.Exists(strTbl) Then
' The first item is the key, the second is the value.
dct(strTbl) = intNumRecs
.MoveNext
i = i + 1
End If
Loop
End With
rst.Close

For Each varItm In dct
sql = "INSERT INTO t_LkupTblCheck ( tbl_name, num_of_recs ) "
_
& "VALUES( '" & varItm & "', " & dct(varItm) & ");"
db.Execute sql
Next

ExitHere:
Set dbe = Nothing
Set db = Nothing
Set dct = Nothing
Exit Function

fuCheckLkupTables_Error:

MsgBox "Error " & Err.Number & " (" & Err.description & ") " _
& "in procedure fuCheckLkupTables of Module basCheckLkupTables"

End Function
 
I really see no point in either alternative.

What's wrong with looping through the recordset?
 
Looping is what I normally would of done, but I wanted to expierment
with GetRows. So, if I have any real need for GetRows in the future,
I have a example to use.

Have a good week.

Bob
 
Back
Top