Looping Through Database Objects 1

[Knicks]

I have VBA code that will generate a list of tables and fields in my database. The place I work has a ton of legacy databases many are slated to be upsized to SQL back-ends in the future.

I need to generate a report of records that have DATES that will fail when upsizing to SQL so that the data can be corrected prior to upsizing.

I have a table called "tblobjects2" that contains all the table names, field names, and field types from the database. I Need to create either a table or report that shows all the records that contain records where the date will fail - < 01/01/1900 or >= 01/01/2076. I will need at least the primary key to locate the records, but all fields outputted would be fine too. My table does contain a field called idxprimary that when = true is part or all of the primary key.

Within tblobjects2 the fields are tblname, fldname, and fldtype (8 = date). I need to be able to create looping SQL expressions that loops through tblobjects2 for the table and field names where the date is out of range for SQL upsizing. If it makes it easier I can pre-generate just a table that contains only table names and field names that have the Date type. Some tables may have multiple DATE fields.

Any suggestions would be appreciated.

 

[JBinQLD]

G'day fella,

If I understand your problem correctly, hopefully this will help. The code is untested but hopefully it's not too far out and should give you some ideas that could be expanded upon. As it stands it should generate a pile of queries names Result1, Result2, Result3 etc which you can then open to show problem records.

I prefer this to outputting everything to one report as this way it's easier to split into chunks for your "fixing" team. They can be issued a few queries each and set about finding/fixing the records.


a) Create a query that will list tblname, fldname where fldtype=8

b) make a quick routine that will tell you the tables with problem fields

dim db as database
dim rs as recorset
dim strTable as string
dim strField as string
dim qd as querydef
dim intLooper as integer

set db=currentdb
set rs=db.openrecordset("qryMmadeAbove",dbopendynset)

rs.movefirst
do until rs.eof 'loop through our query created above
   strTable=rs!tblName
   strField=rs!fldName
   'Create SQL on the fly which displays results in our range
   strSQL="SELECT " & strTable & ".* FROM " & strTable &_
          " WHERE " & strField & " BETWEEN #1/1/1900# AND #1/1/2076#"
    'CHECK QUERY HAS SOME RESULTS!
    'Otherwise next step will generate queries that have no results - waste!
    'IF results>0 then
        'Save our SQL as a query
        Set qd = New QueryDef
        qd.Name = "Result" & cstr(intLooper)
        qd.SQL = strSQL
        db.QueryDefs.Append qd
        Set qd = Nothing
        intLooper=intLooper+1
    'endif
    rs.movenext
loop
set rs=nothing
set db=nothing
msgbox("Queries Made")

Apologies if I've mis-understood and given you a bum steer, further apologies didn't get to test/finish code - hopefully the comments show where I'm headed though.

JB

 

[Knicks]

Thank you for your help. The procedure is fails right at the point of query creation. See highlighted

Public Sub createqueries()
Dim db As Database
Dim rs As Recordset
Dim strTable As String
Dim strField As String
Dim strSQL As String
Dim qd As QueryDef
Dim intLooper As Integer

Set db = CurrentDb
Set rs = db.OpenRecordset("qryOutOfRange")

rs.MoveFirst
Do Until rs.EOF 'loop through our query created above
strTable = rs!tblName
strField = rs!fldName
'Create SQL on the fly which displays results in our range
strSQL = "SELECT """ & strTable & """.* FROM """ & strTable & """ WHERE """ & strField & """ < #1/1/1900# AND >#1/1/2076#"

'CHECK QUERY HAS SOME RESULTS!
'Otherwise next step will generate queries that have no results - waste!
'IF results>0 then
'Save our SQL as a query
Set qd = New QueryDef
qd.Name = "Result" & CStr(intLooper)
qd.SQL = strSQL
db.QueryDefs.Append qd
Set qd = Nothing
intLooper = intLooper + 1
'endif
rs.MoveNext
Loop
Set rs = Nothing
Set db = Nothing
MsgBox ("Queries Made")

End Sub

 

[Knicks]

Here is the sticking part, it has to do with using variables as field names or table names in the strSQL string.

strSQL = " SELECT * FROM """ & strTable & """ where """ & strField & """ <#1/1/1900# Or """ & strField & """ >#1/1/2076#;"


This is the debug line, it looks like it can handle the potential for spaces in the name by auto putting in the underscores, but as you can see it is putting the variables in with quotes. I need to remove those quotes

SELECT * FROM "AIDSInterviewData" where "Date_Form_Completed" <#1/1/1900# Or "Date_Form_Completed" >#1/1/2076#;

 

[Knicks]

Ok using the strSQL below it works until it reaches fields/tables with spaces. I will need to get those brackets in.

strSQL = " SELECT * FROM " & strTable & " where " & strField & " < #1/1/1900# Or " & strField & " > #1/1/2076#;

 

[Knicks]

This put the brackets in!

strTable = "[" & rs!tblName & "]"
strField = "[" & rs!fldName & "]"
strSQL = " SELECT * FROM " & strTable & " where " & strField & " < #1/1/1900# Or " & strField & " > #1/1/2076#;

 

[Knicks]

Ok, I have figured out the brackets and the naming convention.

The portion that is failing now is less important but would be cool if I could get the portion of query creation dependant upon RECORDS.

IF results>0 then
'Save our SQL as a query
Set qd = New QueryDef
qd.Name = "Result" & cstr(intLooper)
qd.SQL = strSQL
db.QueryDefs.Append qd
Set qd = Nothing
intLooper=intLooper+1
end if
rs.movenext


Do I need to execute the StrSQL string first and then tie that to the results?

 

[Knicks]

I have figured out the record portion and will post the whole code that I used here for anyone in the future who would like to use table definition data to create queries in VBA.


Public Sub createqueries()
Dim db As Database
Dim rs As Recordset
Dim rst As Recordset
Dim strTable As String
Dim strField As String
Dim strField2 As String
Dim strTable2 As String
Dim strSQL As String
Dim qd As QueryDef
Dim intLooper As Integer

Set db = CurrentDb
Set rs = db.OpenRecordset("qryOutOfRange")

rs.MoveFirst
Do Until rs.EOF 'loop through our query created above
strTable = "[" & rs!tblName & "]"
strField = "[" & rs!fldName & "]"
strTable2 = rs!tblName & "_"
strField2 = rs!fldName
'Create SQL on the fly which displays results in our range
strSQL = " SELECT * FROM " & strTable & " where " & strField & " < #1/1/1900# Or " & strField & " > #1/1/2076#;"
Debug.Print strSQL

Set rst = db.OpenRecordset(strSQL)
'CHECK QUERY HAS SOME RESULTS!
'Otherwise next step will generate queries that have no results - waste!



If rst.RecordCount > 0 Then
'Save our SQL as a query
Set qd = New QueryDef
'qd.Name = "Result" & CStr(intLooper)
qd.Name = strTable2 & strField2
qd.SQL = strSQL
db.QueryDefs.Append qd
'db.QueryDefs.Append qd
Set qd = Nothing
intLooper = intLooper + 1
End If
rst.Close
rs.MoveNext
Loop
Set rs = Nothing
Set db = Nothing
MsgBox ("Queries Made")

End Sub