Using VBA Variable as query criteria?

[Cbrine]

Is anyone aware of a way to assign a vba variable for use as a query parameter? I have a couple of dates that I need to use as both variables and query parameters, and currently I type them both in twice. I was hoping there might be a way to run the query using the VBA Variables as the parameters values?

 

[mdmilner]

Only way I know is to use a VBA routine that (re)creates the query for each use. Variables only exist while a function is running...local/global.

Forms might be an option.

Mike

 

[Cbrine]

Thanks,
I use forms most of the time, but this VBA macro only runs queries does DOA processing on tables and presents me with the final results in a query datasheet No form required. Oh well, I guess I will just continue typing twice.

I guess I could also convert my query to SQL, this would allow me to use parameters wouldn't it?

 

[Philem]

Hullo! I'm including some code from one of my Access/97 db's, that shows how to use a variable in a parameter query. It shows many other things, which I'll trim out, but the salient portion (near the bottom of the included code) should get you rolling:

Option Compare Database
Option Explicit

Function sMassivePODetailPopulate()

Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim qd As QueryDef
Dim rs As Recordset
Dim intLastCol As Integer
Dim boolXL As Boolean
Dim boolClean As Boolean

Dim strShtName As String
Dim intFW As Integer
Dim strSheets(4) As String
Dim x As Integer
Dim y As Integer
Dim strWkbName As String

Dim strTemp As String
Dim lngCount As Long
Dim strRecTo(1, 0) As String
Dim strRecCC(1, 2) As String
Dim strRecBC(1, 0) As String
Dim varAttach(4) As Variant
Dim cGW As GW
Dim strUser As String

Dim ErrNum As Long
Dim ErrDescr As String

#Const fDebug = False

On Error GoTo Err_Handler

strUser = fOSUserName()

strSheets(1) = "floral"
strSheets(2) = "homedec"
strSheets(3) = "craftnotion"
strSheets(4) = "seasonal"

x = 1
boolClean = False

'Err.Raise 65535, , "A test error message."
Set db = CurrentDb
Set qd = db.QueryDefs("qryCurrentFW")
Set rs = qd.OpenRecordset
    With rs
        intFW = !FW.Value
    End With
Set db = Nothing
Set qd = Nothing
Set rs = Nothing

Screen.MousePointer = 11

If fIsAppRunning("Excel") Then
    Set objXL = GetObject(, "Excel.Application")
    boolXL = False
Else
    Set objXL = CreateObject("Excel.Application")
    boolXL = True
End If

Do Until x = 5     '<<--UPDATE FOR REAL RUN (should be 5)

With objXL
    .Workbooks.Open ("Q:\Inventory Management\PO Tracking\DataFiles\bigcontlist.xls")
    .Workbooks.Open ("Q:\Inventory Management\PO Tracking\DataFiles\OrderStat Master.xls")
    .Workbooks.Open ("Q:\Inventory Management\PO Tracking\DataFiles\Vendors.xls")
    .Workbooks.Open ("Q:\Inventory Management\PO Tracking\DataFiles\vslinfo.xls")
End With

strWkbName = "c:\my documents\current po track sandbox\fw" & intFW & " " & strSheets(x) & ".xls"
varAttach(x) = strWkbName
  Set db = CurrentDb
  Set objXL = Excel.Application
  objXL.Windows(1).Visible = True
  objXL.WindowState = xlMinimized
  
    
  With objXL
    .Visible = True
    .WindowState = xlMinimized
    Set objWkb = .Workbooks.Open(strWkbName)
    On Error Resume Next
    
  Dim ws As Worksheet
  
  For Each ws In Worksheets
  ws.Activate
  strShtName = .ActiveSheet.Name
  Set qd = db.QueryDefs("qryMassive")
  qd.Parameters("Unit?") = strShtName '<--- This is the query parameter
  Set rs = qd.OpenRecordset
    Set objSht = objWkb.Worksheets(strShtName)
    Err.Clear
    On Error GoTo 0
    intLastCol = objSht.UsedRange.Columns.Count
    With objSht
      .Range("a16").CopyFromRecordset rs
    End With
    
<<SNIP>>

I left in some of the beginning chaff to show the declaration of the variable in question strShtName

HTH

P

 

[Cbrine]

Philem,
Thanks for the code, I believe I have implemented it correctly

Set db = CurrentDB
set qd = db.querydefs("Y: Quarterly Bonus-Procesed History")

QD.Parameters("Q StartDate") = StartDate
QD.Parameters("Q EndDate") = EndDate
QD.OpenRecordset

I think it is working, it's just not returning the values to the screen. What I'm hoping to do is to basically run a
Docmd.OpenQuery
with parameters, so that the data is returned in a dataset listing on the screen.(Just like double clicking on the MSAccess query)
Is this possible, or do I have to execute the query and save the results to a table, then display the table? Seems like a lot of work just to assign the parameters for a query!!!!

 

[mdmilner]

I was vague. Yes you can do this. My preferred method is to include the WHERE parameter within the SQL itself instead of using as a Parameter.
What I do is build the WHERE condition via VBA

This was something I did awhile ago, and I plead insanity as my excuse!

I'd send calls to this Function to return full SQL commands based on the contents of a table (the SQL was saved in Table fields to keep me from needing to dig it out of code every time)

Public Function GenerateSQL(strTask As String, Optional qWhere As String, Optional strTBL As String) As String
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim rsf As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strSRC As String, strDEST As String, strWHEREQ As String, strQRYD As String
Dim strQRY As String

Set dbs = CurrentDb

On Error GoTo Err_handler

Set rs = dbs.OpenRecordset("Select * from tblSQL", dbOpenSnapshot)
rs.Filter = "fldTaskName = '" & strTask & "'"
Set rsf = rs.OpenRecordset()

With rsf
  If .RecordCount > 1 Then
    MsgBox "More than one match found"
    GoTo ExitFunction
  Else
    strSRC = !fldSRC
  End If
  
  If !fldSRCQ <> "" Then  ' Use tblSQL unless empty
    strQRY = !fldSRCQ
  Else
    strQRY = FindDefaults(strSRC)
  End If
  strQRYD = !fldDESTQ
  If !fldWHEREQ <> "None" Then
    strWHEREQ = !fldWHEREQ
  End If
  If qWhere <> "" Then
    strWHEREQ = qWhere
  End If

    Select Case !fldType:
      Case "SELECT":
        If ObjectExists("Query", "qry" & strTask) Then
          DoCmd.DeleteObject acQuery, "qry" & strTask
        End If
        GenerateSQL = "PROCEDURE qry" & strTask & "; " _
              & !fldType & " " & strQRY & " FROM " & strSRC & " " & strWHEREQ
        'Set qdf = dbs.CreateQueryDef("qry" & strTask, GenerateSQL)
        'DoCmd.OpenQuery "qry" & strTask
      Case "DELETE":
        GenerateSQL = "DELETE " & !fldSRCQ & " FROM " & strSRC & " " & strWHEREQ
        'DoCmd.RunSQL GenerateSQL
      Case "INSERT":
        GenerateSQL = "INSERT INTO " & !fldDEST & " " & !fldDESTQ & " SELECT " & !fldSRCQ & " FROM " & strTBL & " " & strWHEREQ
      Case "UPDATE":
        GenerateSQL = "UPDATE " & !fldSRC & " " & !fldSRCQ
    End Select

End With

ExitFunction:
Set rsf = Nothing
Set rs = Nothing
Set dbs = Nothing
Exit Function

Err_handler:
Dim strXX As String
  Select Case Err.Number:
    Case 3075:      'Syntax error in SQL statement
        strXX = "The following SQL statement has syntax error."
        strXX = strXX & vbCrLf & "Please verify the SQL string and try again."
        strXX = strXX & vbCrLf & vbCrLf & GenerateSQL
        MsgBox strXX, vbCritical + vbOKOnly, "Error in SQL Statement"
  End Select
  Err.Clear

End Function