Category: All

Continuing the theme of tools that assist the use of MS Access as a platform for transferring data between systems. Here is a small function that will allow you to write the pure SQL syntax of all queries in a database to a table. I personally used this in a system transfer project. The business had given us something called a field mapping plan that identified the table and fields in one system and where they were to be migrated in the other system. Having written the queries I then wanted to go back through and reconcile the original mapping to the SQL to ensure that absolutely every field had been taken across. Writing the SQL into a table allows for table and field combinations to be methodically searched. Quite useful.

Create a table called T001SQLCollection with at least 2 fields – QueryName and SQL. This is where the recordset writes the SQL to.

This is very much a reverse of the previous post function.

Public Function ListQueries()
 
Dim rstList As DAO.Recordset
 
    Dim i As Integer
        For i = 0 To CurrentDb.QueryDefs.Count - 1
        Set rstList = CurrentDb.OpenRecordset("T001SQLCollection")
        With rstList
            .AddNew
            rstList!QueryName = CurrentDb.QueryDefs(i).Name
            rstList!SQL = CurrentDb.QueryDefs(i).SQL
            rstList.Update
        End With
    Next i
   
    rstList.Close   
 
MsgBox "Finished"
 
End Function

In line with my general theme of automation here’s the framework of a tiny but potentially very useful function to create queries in the current database, linking this in with the loop queries and say something like the nested IF generation function could allow you to take your table of nested queries and write them to the database.

Public Function CreateQuery()

Dim strSQL As String
Dim qdf As Variant

strSQL = "SELECT * FROM T01Contacts"

Set qdf = CurrentDb.CreateQueryDef("GeneratedQuery", strSQL)
MsgBox "GeneratedQuery Created!"

End Function

I like!

So in my previous post I had looked at generating single SQL Nested IF statements using MS Access but had highlighted that Access will error out indicating the SQL is too complex should there be more than 13 nested IIFs in a single SQL.

What happens if you have 20 values that you require to be changed.
Answer = you pick 13 and produce one sql statement with 13 nested if statements and another with 7 nested IIF statements.

But damn it,doesn’t that introduces yet another manual step to what was supposed to be automation. Yes it does this is why I wrote this function which allows you to define the number of nestings and will go off and write the appropriate number. And yes I hear you DBAs saying a better way would be to link in the conversion table at the beginning – absolutely but there may be occasions where you can’t link to the required database.

The following iterates through a conversion table and writes the resulting SQL into a table named T005NestedIIFs – it should be noted that the Wend statement is artificially optomised here and if you have an extremely large code conversion table you may need to work on this code to make it dynamically alter the number of WEND statements depending on the BatchFileNo you wish to create and its relation to the number of records in the conversion table. The below code goes to the last record as part of the recordset count and when at 0 will jump to exit so for smaller code conversions its semi-dynamic but for larger files the limit of values converted with be the BatchFileSize * 200 which may or may not be big enough for purpose.

To have this working you will need two tables and knowledge of a third.
T001ConversionCodeTable
This should have 5 fields
OldValue
NewValue
xFlag1
xFlag2
xFlag3

The flag fields only require a single integer value. They are used to record how far through the conversion table you have reached so that when you break from your SQL query you resume at the finish of your former position.

The queries are placed in table
T005NestedIIFs
In which I have created 3 fields
One marked SQLfield
Targtable
Targfield

Public Function CreateTableofSQL(TargetTable As Variant, TargetFieldforUpdate As Variant, BatchSizeNo As Long)
On Error GoTo Err_Writetofile

Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim rst3 As DAO.Recordset
Dim rst4 As DAO.Recordset
Dim RecordCount1 As Long
Dim RecordCount2 As Long
Dim LCounter As Integer
Dim SQLString1 As String

LCounter = 1


While LCounter < 200

LCounter = LCounter + 1

SQLString1 = ""

'Three recordsets were testing differing flag fields because order of the integrity of the recordsets were being affected by each other
Set rst2 = CurrentDb.OpenRecordset("SELECT TOP " & BatchSizeNo & " T001CodeConversionTable.PKID, T001CodeConversionTable.OldValue, T001CodeConversionTable.NewValue, T001CodeConversionTable.xFlag2 FROM T001CodeConversionTable WHERE (((T001CodeConversionTable.xFlag2)<>1));")
Set rst3 = CurrentDb.OpenRecordset("SELECT TOP " & BatchSizeNo & " T001CodeConversionTable.PKID, T001CodeConversionTable.OldValue, T001CodeConversionTable.NewValue, T001CodeConversionTable.xFlag3 FROM T001CodeConversionTable WHERE (((T001CodeConversionTable.xFlag3)<>1));")
Set rst = CurrentDb.OpenRecordset("SELECT TOP " & BatchSizeNo & " T001CodeConversionTable.PKID, T001CodeConversionTable.OldValue, T001CodeConversionTable.NewValue, T001CodeConversionTable.xFlag1 FROM T001CodeConversionTable WHERE (((T001CodeConversionTable.xFlag1)<>1));")

'MoveLast required to ensure correct record count at first pass reset to first after this
rst.MoveLast
RecordCount1 = rst.RecordCount
rst.MoveFirst
rst3.MoveLast
RecordCount2 = rst3.RecordCount
rst3.MoveFirst

SQLString1 = SQLString1 & "UPDATE " & TargetTable & " SET " & TargetTable & "." & TargetFieldforUpdate & "="
Do Until rst.EOF = True
rst.Edit
rst!xFlag1 = 1
rst.Update
RecordCount1 = RecordCount1 - 1
SQLString1 = SQLString1 & "IIF((" & TargetTable & "!" & TargetFieldforUpdate & "='" & rst!OldValue & "'),'" & rst!NewValue & "'"
If RecordCount1 = 0 Then
SQLString1 = SQLString1 & " "
Else
SQLString1 = SQLString1 & ","
End If
rst.MoveNext
Loop

rst.Close

Do Until rst2.EOF = True
SQLString1 = SQLString1 & ")"
rst2.Edit
rst2!xFlag2 = 1
rst2.Update
rst2.MoveNext
Loop
SQLString1 = SQLString1 & " WHERE (("

rst2.Close

Do Until rst3.EOF = True
RecordCount2 = RecordCount2 - 1
SQLString1 = SQLString1 & "(" & TargetTable & "!" & TargetFieldforUpdate & ")='" & rst3!OldValue & "'"
rst3.Edit
rst3!xFlag3 = 1
rst3.Update
If RecordCount2 = 0 Then
SQLString1 = SQLString1 & " "
Else
SQLString1 = SQLString1 & " OR "
End If

rst3.MoveNext
Loop

rst3.Close

SQLString1 = SQLString1 & "));"


Set rst4 = CurrentDb.OpenRecordset("T005NestedIIFs")
With rst4
.AddNew
rst4!SQLfield = SQLString1
rst4!Targfield = TargetFieldforUpdate
rst4!Targtable = TargetTable
rst4.Update
rst4.Close
End With

Wend

Exit_WritetoFileError:
 Exit Function

Err_Writetofile:
    If Err.Number = 3021 Then
    MsgBox "All records in Translation table written out no more to translate"
    Else
    MsgBox Err.Description
    End If
 Resume Exit_WritetoFileError

End Function

I came across a situation at work where we were needing to alter a large number of values in particular fields from one value to another. Here is a function I put together to assist in this. After some thought it was obvious that this would be better accomplished joining the conversion table in the query editor and moving on from there, particularly because MS Access has a limit on the number nested IIFs allowed in a single statement. Nonetheless I publish it here as it may prove useful.

Here I create a table T001CodeConversionTable that holds the translation from one set of codes to another. This field also has to have several fields in it named
OldValue
NewValue

The variables TargetTable and TargetFieldforUpdate exist in the table that will have the resultant SQL performed on it.

Public Function CreateNestedIF(TargetTable As Variant, TargetFieldforUpdate As Variant)

Dim rst As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim rst3 As DAO.Recordset
Dim RecordCount1 As Long
Dim RecordCount2 As Long

Set rst = CurrentDb.OpenRecordset("T001CodeConversionTable")
Set rst2 = CurrentDb.OpenRecordset("T001CodeConversionTable")
Set rst3 = CurrentDb.OpenRecordset("T001CodeConversionTable")

RecordCount1 = rst.RecordCount
RecordCount2 = rst3.RecordCount

Dim fs, TextFile
Set fs = CreateObject("Scripting.FileSystemObject")
Set TextFile = fs.CreateTextFile("C:\Users\Mark\Documents\NestedIFs.txt", True)
TextFile.WriteLine ("UPDATE " & TargetTable & " SET " & TargetTable & "." & TargetFieldforUpdate & "=")
Do Until rst.EOF = True
RecordCount1 = RecordCount1 - 1
TextFile.WriteLine ("IIF((" & TargetTable & "!" & TargetFieldforUpdate & "='" & rst!OldValue & "'),'" & rst!NewValue & "'")
If RecordCount1 = 0 Then
TextFile.WriteLine ("")
Else
TextFile.WriteLine (",")
End If
rst.MoveNext
Loop

rst.Close

Do Until rst2.EOF = True
TextFile.WriteLine (")")
rst2.MoveNext
Loop
TextFile.WriteLine ("WHERE ((")

rst2.Close

Do Until rst3.EOF = True
RecordCount2 = RecordCount2 - 1
TextFile.WriteLine ("(" & TargetTable & "!" & TargetFieldforUpdate & ")='" & rst3!OldValue & "'")
If RecordCount2 = 0 Then
TextFile.WriteLine ("")
Else
TextFile.WriteLine ("OR")
End If
rst3.MoveNext
Loop

rst3.Close

TextFile.WriteLine ("));")

TextFile.Close

MsgBox "Created NestedIFs File in C drive"

End Function

Allen Browne Functions Index

Technet list of functions

I was curious Sub Routines and Functions appear to perform almost the same thing what is the difference and what are their relative advantages?

Functions return a value that is stored whereas subs don’t. The main difference is not only the return value, it seems that subs are faster than functions (at least in .net) because the MSIL code of subs is much shorter when no value is returned. so overall subs are faster when no value is returned.

MSIL stands for Microsoft Intermediate Language – which is the a programming language that has been standardized later as the Common Intermediate Language

Functions vs Sub Routines

Function TypicalWhileLoop()
'This performs the same as next loop but uses the while loop

 Dim LCounter As Integer
    LCounter = 1
    
    While LCounter < 10


    MsgBox (LCounter)


    LCounter = LCounter + 1


    Wend

End Function

Function TypicalForNextExample()
'This performs the same as the while loop but uses for next

    Dim i As Integer
    
    For i = 1 To 9
    MsgBox (i)
    Next i


End Function

Function TypicalDAOrecordset()

'Make sure the name of the recordset is unambiguous
'Good practice to reference the actual library
        
    Dim rs As DAO.Recordset
    Dim db As DAO.Database
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT * FROM T001Main where T001Main.ValueNumber = 0")
    
        'the data source can be a Table Name a query name or an sql string
        'it would be possible to change the SQL to set to another set of records
        'Check to see if there are any records in the set
        
        If Not (rs.EOF And rs.BOF) Then
        'there are no records if End of File and beginning of file are both true
        
            rs.MoveFirst
            
            Do Until rs.EOF = True
            rs.Edit
            rs!ValueNumber = 300
            rs.Update
            rs.MoveNext
            Loop
            Else
            MsgBox "No Records available for updating exit sub"
            Exit Function
            End If
            MsgBox "Looped through the records and updated ValueNumber field"
            
            rs.Close
            Set rs = Nothing
            Set db = Nothing
            
            'libraries for DAO can be found on AllenBrowne site
            'remember to break an infinite loop press ctrl + break

End Function