Using Passthrough query in MASC

Sep 12
2012

We have recently converted a database from Access to SQL and needed to increase the speed of the reports when working with a large recordset. We amended this code from the web which significantly increased the speed on 2 reports but reduced the speed on another – so its a case of testing to get the best results.

Public Sub PassThrough(strSQL As String, tmpQry)
On Error GoTo ErrHandler
 
Dim obj As QueryDef
Dim dbsCurrent As Database
Dim qdfPassThrough As QueryDef
 
Set dbsCurrent = CurrentDb()
 
'delete the existing query
For Each obj In dbsCurrent.QueryDefs
     If obj.Name = tmpQry Then dbsCurrent.QueryDefs.Delete tmpQry
Next
 
 
Set qdfPassThrough = dbsCurrent.CreateQueryDef(tmpQry)
qdfPassThrough.Connect = "ODBC;DSN=MASCSql;DATABASE=mascdataSQL;UID=xxxx;PWD=yyyy" ' replace with your details
qdfPassThrough.SQL = strSQL ' this is generated from the form taking the parameters and changing the table names to add the dbo. 
qdfPassThrough.ReturnsRecords = True 
 
dbsCurrent.Close
 
Exit_ErrHandler:
Exit Sub
 
ErrHandler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_ErrHandler
End Sub

Checking the References in an Access Database

Sep 12
2012

This code from the MS site checks the references and can fix broken references – the compile will only work in an mdb version

Function CheckRefs()
   Dim db As Database, rs As Recordset
   Dim x
   Set db = CurrentDb
 
   On Error Resume Next
 
   ' Run the query qryTestRefs you created and trap for an error.
   Set rs = db.OpenRecordset("qryTestRefs", dbOpenDynaset)
 
   ' The if statement below checks for error 3075. If it encounters the
   ' error, it informs the user that it needs to fix the application.
   ' Error 3075 is the following:
   ' "Function isn't available in expressions in query expression..."

   ' Note: This function only checks for the error 3075. If you want it to
   ' check for other errors, you can modify the If statement. To have
   ' it check for any error, you can change it to the following:
   ' If Err.Number <> 0

    If Err.Number = 3075 Then
      MsgBox "This application has detected newer versions " _
             & "of required files on your computer. " _
             & "It may take several minutes to recompile " _
             & "this application."
      Err.Clear
      FixUpRefs
   End If   
 
End Function
 
Sub FixUpRefs()
    Dim loRef As Access.Reference
    Dim intCount As Integer
    Dim intX As Integer
    Dim blnBroke As Boolean
    Dim strPath As String
 
    On Error Resume Next
 
    'Count the number of references in the database
    intCount = Access.References.Count
 
    'Loop through each reference in the database
    'and determine if the reference is broken.
    'If it is broken, remove the Reference and add it back.
    For intX = intCount To 1 Step -1
      Set loRef = Access.References(intX)
      With loRef
        blnBroke = .IsBroken
        If blnBroke = True Or Err <> 0 Then
          strPath = .FullPath
          With Access.References
            .Remove loRef
            .AddFromFile strPath
          End With
        End If
       End With
    Next
 
  Set loRef = Nothing
 
  ' Call a hidden SysCmd to automatically compile/save all modules.
  Call SysCmd(504, 16483)
End Sub

If you need some help on a project drop leave a comment on the post and I will reply.