Access is both a handy tool and a pain in the neck to use. It removes all of the complexities of using SQL Server, DB2, or Oracle and provides a nice point and click interface. However, It does not follow all of the SQL rules and will not do full outer joins. Also, Access documentation and support sucks. It does provide a VBA interface that allows us to code around the problems.
Running a systems analysis on an IBM mainframe involves many people. We exchange information using Access. It's not a great database but is a very handy tool in that it is powerful enough to run SQL queries, a database and all of the queries can be copied in a single file with no special setup requirements, handles a lot of data import and export, and the management can use it too.
I was analyzing z/OS JCL and needed to run a stored query 90 times to get a sample set of data for 90 days. I came up with two solutions. The first created a text file using tab delimiters and the second built a table dynamically. The core code should work for any record set created from any query.
This code just sets the parameters and runs the queries:
Function fRunGet90()
Dim sd As Date
Dim ed As Date
Dim strFileName As String
Dim cntr As Long
strFileName = CurrentProject.Path & "\qryUse_90Days.txt"
sd = #12/15/2011 7:00:00 AM#
ed = #3/14/2012 7:00:00 AM#
cntr = fGet90(sd, ed, strFileName, 90)
Debug.Print cntr
cntr = fGet90_2()
Debug.Print cntr
End Function
The function fGet90() takes a start and end date, an output text file name and the number of days (iterations) to run as arguments. DAO.QueryDef is used to run the Access stored query. DAO stands for Data Access Objects, the native library Microsoft exposing objects in Access. Except for earlier versions of Access like 2000 and 2002, all versions have this library.
Create the text file for output and set the name of the query in the QueryDef object.
Function fGet90(sd As Date, ed As Date, strFileName As String, days As Integer) As Long
' ---------------------------------------------------------------
'
' This Access 2007 VBA program creates a text file from multiple calls to a stored
' Access query that takes parameters
'
' ---------------------------------------------------------------
' From start and end dates like these:
' 2011/12/15 07:00:00
' 2012/03/14 07:00:00
' run days times and gather the results incrementing 1 day at a time
' ---------------------------------------------------------------
Dim dbDatabase As DAO.Database
Dim rsRecordset As DAO.Recordset
Dim qdParameters As DAO.QueryDef
Dim str As String
Dim cntr As Long
cntr = 0
Open strFileName For Output As #1 ' create the output text file
Set dbDatabase = CurrentDb()
' set the query name
Set qdParameters = dbDatabase.QueryDefs("qryUse")
The first loop controls the call to the query and at the top the start and end dates are set for the run and a record set is generated by calling the stored query:
For DayCount = 1 To days
' update the date parameters
qdParameters.Parameters("StartDate") = sd '"2011/12/15 07:00:00"
qdParameters.Parameters("EndDate") = ed '"2012/03/14 09:00:00"
Set rsRecordset = qdParameters.OpenRecordset()
With rsRecordset
rsRecordset.MoveFirst
' place the field names
When processing the record set for the first time use a flag, or in this case a counter, to test if this is the first iteration and loop through the recordset fields to create a column title list. Notice the separator can be any character and tabs a used because they cut and paste so easily into Excel (another ubiquitous off tool). If using the comma name the file with a .CSV suffix for comma separated values and it can be opened directly by Excel. I used tabs due to embedded commas in several field of the data:
If Not rsRecordset.EOF And cntr = 0 Then ' only write out the field names once
str = vbNullString
For Each fld In rsRecordset.Fields
str = str & fld.Name & vbTab
'str = str & fld.Name & ","
Next
str = Mid(str, 1, Len(str) - 1) '--remove last separator
Print #1, str 'write the titles
End If
Do
str = vbNullString
For Each fld In rsRecordset.Fields
'str = str & fld & ","
str = str & fld & vbTab
Next
str = Mid(str, 1, Len(str) - 1) '--remove last separator
Print #1, str ' write the line to the text file
cntr = cntr + 1
rsRecordset.MoveNext
Loop While Not rsRecordset.EOF End With
sd = DateAdd("d", 1, sd) ' add a day to the start and end dates
ed = DateAdd("d", 1, ed)
Take care to close and reset the recordset at the end of each call to the query. If you do not you will quickly run out of and overwrite memory areas and Access has a nasty habit of using the same memory to store your code and run your code and will clobber all of it and possibly corrupt the database too:
rsRecordset.Close
Set rsRecordset = Nothing
Next
Close it all and end the function:
Close #1 ' close the text file
dbDatabase.Close
Set dbDatabase = Nothing
fGet90 = cntr
End Function
This version is exactly the same as the first except it takes no parameters and creates a database table rather than a text file. Access has no function to provide a proper filed type name to be used in data definition language (DDL) so the function FieldTypeName() (thanks to Allen Browne) provides a translation of the field type codes:
Function fGet90_2() As Long
' -----------------------------------------------------------------------------------
'
' This Access 2007 VBA program creates a table in the same databse from multiple calls ' to a stored Access query that takes parameters.
'
' -----------------------------------------------------------------------------------
Dim sd As Date
Dim ed As Date
Dim TableName As String
Dim days As Integer
TableName = "Use90Days"
sd = #12/15/2011 7:00:00 AM#
ed = #3/14/2012 7:00:00 AM#
days = 90
Dim dbDatabase As DAO.Database
Dim rsRecordset As DAO.Recordset
Dim qdParameters As DAO.QueryDef
Dim str As String
Dim cntr As Long
Dim rsTargetRecordset As DAO.Recordset
cntr = 0
Set dbDatabase = CurrentDb()
' set the query name
Set qdParameters = dbDatabase.QueryDefs("qryUse")
For DayCount = 1 To days ' run the query and process the record set n times placing all into a target table
' update the date parameters
qdParameters.Parameters("StartDate") = sd '"2011/12/15 07:00:00"
qdParameters.Parameters("EndDate") = ed '"2012/03/14 07:00:00"
' Get and set the record set
Set rsRecordset = qdParameters.OpenRecordset()
'Process the recordset
With rsRecordset
rsRecordset.MoveFirst ' or just MoveFirst since we are using With
' place the field names inot a create table string
Processing the recordset and creating the table on the first iteration:
If Not rsRecordset.EOF And cntr = 0 Then ' only create the table once
'str = vbNullString
' delete the table if it exists
Destroy any existing version of the table but if it does not exist the code will stop so use a scan:
' this fails if the table does not exist
'str = "DROP TABLE " & TableName & " ;"
'dbDatabase.Execute (str)
' So use this which will always work
For i = 0 To dbDatabase.TableDefs.Count - 1
If dbDatabase.TableDefs(i).Name = TableName Then
' this fails if the table is open in Access
dbDatabase.TableDefs.Delete (TableName)
Exit For
End If
Next
Create the new table and a recordset for it:
str = "create table " & TableName & " ("
For Each fld In rsRecordset.Fields
str = str & fld.Name & " " & FieldTypeName(fld) & ","
Next
str = Mid(str, 1, Len(str) - 1) '--remove last comma
str = str & " );"
' Create the table
dbDatabase.Execute (str)
' set the target table recordset
Set rsTargetRecordset = dbDatabase.OpenRecordset(TableName)
End If
Notice that AddNew and Update must be called for the target recordset each time a new record is to be added:
' Process each record
Do
rsTargetRecordset.AddNew ' create a new record
' process each field and place it in the table
For Each fld In rsRecordset.Fields
rsTargetRecordset.Fields(fld.Name) = rsRecordset.Fields(fld.Name)
Next
rsTargetRecordset.Update ' write the record
cntr = cntr + 1
rsRecordset.MoveNext
Loop While Not rsRecordset.EOF
End With
sd = DateAdd("d", 1, sd) ' add a day to the start and end dates
ed = DateAdd("d", 1, ed)
Here code is added to ensure the recordset object exists and is capable of being closed:
If Not rsRecordset Is Nothing Then
rsRecordset.Close
Set rsRecordset = Nothing
End If
Next
Close and exit the function:
If Not rsTargetRecordset Is Nothing Then
rsTargetRecordset.Close
Set rsTargetRecordset = Nothing
End If
dbDatabase.Close
Set dbDatabase = Nothing
fGet90_2 = cntr
End Function
FieldTypeName() is just a big case statement returning a field type name as a string but it is a big help. The original code used a DAO.Field as an argument and returned a report formatted field type name. Using a variant type argument was required to make this code work in Access 2007. Note that not all of this code is tested and some of the values returned may not be DDL syntax correct due to problems finding anything in Microsoft's Access documentation:
Function FieldTypeName(fld As Variant) As String
' -----------------------------------------------------
' Modified from original code by Allen Browne April 2010
' -----------------------------------------------------
Dim strReturn As String 'Name to return
Select Case CLng(fld.Type) 'fld.Type is Integer, constants are Long
Case dbBoolean: strReturn = "YESNO" ' 1
Case dbByte: strReturn = "Byte" ' 2
Case dbInteger: strReturn = "Integer" ' 3
Case dbLong ' 4
If (fld.Attributes And dbAutoIncrField) = 0& Then
strReturn = "LONG"
Else
strReturn = "AutoNumber"
End If
Case dbCurrency: strReturn = "Currency" ' 5
Case dbSingle: strReturn = "Single" ' 6
Case dbDouble: strReturn = "Double" ' 7
Case dbDate: strReturn = "DateTime" ' 8
Case dbBinary: strReturn = "Binary" ' 9 (no interface)
Case dbText '10
If (fld.Attributes And dbFixedField) = 0& Then
strReturn = "Text"
Else
strReturn = "Text (" & fld.Size & ")" '(no interface)
End If
Case dbLongBinary: strReturn = "LONGBINARY" '11 (an OLE Object)
Case dbMemo '12
If (fld.Attributes And dbHyperlinkField) = 0& Then
strReturn = "Memo"
Else
strReturn = "Hyperlink"
End If
Case dbGUID: strReturn = "GUID" '15
'Attached tables only: cannot create these in JET
Case dbBigInt: strReturn = "BigInt" '16
Case dbVarBinary: strReturn = "VarBinary" '17
Case dbChar: strReturn = "Char" '18
Case dbNumeric: strReturn = "Numeric" '19
Case dbDecimal: strReturn = "Decimal" '20
Case dbFloat: strReturn = "Float" '21
Case dbTime: strReturn = "Time" '22
Case dbTimeStamp: strReturn = "TimeStamp" '23
'Constants for complex types don't work prior to Access 2007
Case 101&: strReturn = "Attachment" 'dbAttachment
Case 102&: strReturn = "Complex Byte" 'dbComplexByte
Case 103&: strReturn = "Complex Integer" 'dbComplexInteger
Case 104&: strReturn = "Complex Long" 'dbComplexLong
Case 105&: strReturn = "Complex Single" 'dbComplexSingle
Case 106&: strReturn = "Complex Double" 'dbComplexDouble
Case 107&: strReturn = "Complex GUID" 'dbComplexGUID
Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal
Case 109&: strReturn = "Complex Text" 'dbComplexText
Case Else: strReturn = "Field type " & fld.Type & " unknown"
End Select
FieldTypeName = strReturn
End Function
