Running an Access Parameter Query from Excel

October 19, 2009 by datapig Leave a reply »

An Access parameter query is a kind of interactive query that prompts you for criteria before the query is run. Parameter queries are useful when you need to ask the query different questions using different criteria each time you run it.

Now we all know you can pull data from Access into Excel using MS Query. The problem is that MS Query doesn't let you pull in Parameter queries. There may be a technical reason for this, but I like to think it's just Microsoft's way of keeping things interesting. After all, technical roadblocks are the spice of life.
If you've had enough spice, I'll show you a VBA workaround that will enable you to run an Access parameter query from Excel.

 

The Problem:

I've built this parameter query in Accesss. This particular query will ask the user for a Region and a Business Segment. This works fine in Access.

I've named this query MyParameterQuery.

 

The problem is when I try to connect to this query via MS Query in Excel, I don't see it in the list. It turns out that Parameter queries are not available in list of connectable objects.

 

Even if I try to get cocky, brute forcing MS Query to look at the query, I get the dreaded "Too Few Parameters" error.

 

 

The Solution:

My solution is to use a bit of VBA to pull the data based on parameters you enter directly into Excel.

The first step is to set up a spreadsheet like the one shown here.  You'll notice that the needed parameters will be fed from Cells D3 and D4.

 

Once your spreadsheet is ready to go, switch over to VBA and enter this code into a standard module.

Note: You will need to add a reference to the Microsoft DAO XX Object Library (where XX represents the latest version you have) .

 

PLAIN TEXT
Visual Basic:
  1. Sub RunParameterQuery()
  2.  
  3. 'Step 1: Declare your variables
  4. Dim MyDatabase As DAO.Database
  5. Dim MyQueryDef As DAO.QueryDef
  6. Dim MyRecordset As DAO.Recordset
  7. Dim i As Integer
  8.  
  9. 'Step 2: Identify the database and query
  10. Set MyDatabase = DBEngine.OpenDatabase _
  11. ("C:\Integration\IntegrationDatabase.accdb")
  12. Set MyQueryDef = MyDatabase.QueryDefs("MyParameterQuery")
  13.  
  14. 'Step 3: Define the Parameters
  15. With MyQueryDef
  16. .Parameters("[Enter Segment]") = Range("D3").Value
  17. .Parameters("[Enter Region]") = Range("D4").Value
  18. End With
  19.  
  20. 'Step 4: Open the query
  21. Set MyRecordset = MyQueryDef.OpenRecordset
  22.  
  23. 'Step 5: Clear previous contents
  24. Sheets("Main").Select
  25. ActiveSheet.Range("A6:K10000").ClearContents
  26.  
  27. 'Step 6: Copy the recordset to Excel
  28. ActiveSheet.Range("A7").CopyFromRecordset MyRecordset
  29.  
  30. 'Step 7: Add column heading names to the spreadsheet
  31. For i = 1 To MyRecordset.Fields.Count
  32. ActiveSheet.Cells(6, i).Value = MyRecordset.Fields(i - 1).Name
  33. Next i
  34.  
  35. MsgBox "Your Query has been Run"
  36.  
  37. End Sub

 

After the code is ready, running it will make data magically appear based on your parameters!

Who needs MS Query?

 

This technique allows you to build some interesting reporting solutions with relatively little effort.

Posted in Access Queries, Excel & Access Integration, Excel VBA, MS Query

Tags:

You can follow any responses to this entry through the RSS 2.0 Feed feed. You can leave a response, or trackback from your own site.

Advertisement

77 Responses

Add your comment
Newer Comments »
  1. jpk says:
    October 19, 2009 at 4:45 pm

    Thanks for this. My inability to make parameter queries work from Excel has been a major annoyance.

    I only got this to work, though when I had changed the references to:

    Microsoft Office 12.0 Access Database Engine Object Library, and

    Microsoft Access 12.0 Object library (which should probably have been set before).

    Now it works (mostly - sometimes fails on an
    ODBC call, but I get the feeling that most of these Microsoft ODBC calls are not that robust, and anyway the Access database is linking to a series of tables in VFP format).

  2. Ross says:
    October 19, 2009 at 5:20 pm

    Hi Mike,
    Yes good tip, I had some fun doing somthing not unlike this a while back, in the end the solution was a right hack!
    http://www.blog.methodsinexcel.co.uk/2009/04/28/parameters-in-ado-getting-good-with-access-%E2%80%93-not/#comments

    Thanks
    Ross

  3. Jeff Weir says:
    October 20, 2009 at 1:11 am

    In the book ‘Excel 2007 Advanced Report Development’, Timothy Zapawa talks about how to execute parameter queries in Excel without using VBA.

    Some points of note include:
    • Parameters are not really intended to be used with pivottable reports (but Zapawa provides a work around)

    • Parameters can be used in an Excel query, although if the query cannot be displayed graphically then you’ll need to transform it into a stored procedure or view.

    • Parameters can be integrated with web queries, but otly by creating an .isql file outside of Excel

    There’s some supporting documents and videos posted at http://www.wiley.com/go/excelreporting/2007 that might be of interest – check out the files on offer under chapter 15: there’s a sample spreadsheet (which I can’t use on my PC because I don’t have the sample database loaded) and a video (which I cant view on my PC for some reason).

    I personally find this book almost impossible to follow. Either I’m dumb, or the book is not written for beginners, or both.

  4. Andy says:
    October 20, 2009 at 1:39 am

    Thanks for this great article. Parameter queries can be tricky but this is an easy to follow walk through. You should consider sharing your knowledge and expertise with the Office community on Facebook. Check it out at http://www.facebook.com/office

    Cheers,
    Andy
    MSFT Office Outreach Team

  5. Roger says:
    October 20, 2009 at 6:39 pm

    Thanks for this, it helped me a lot with a project.
    I have just one question, how can I close the connection with the DB without closing the Excel file?

    Thanks

    Roger

  6. datapig says:
    October 20, 2009 at 11:21 pm

    Roger: You could set the object variables to nothing.

    Set MyRecordset = Nothing
    Set MyQueryDef = Nothing
    Set MyDatabase = Nothing

  7. Colin Banfield says:
    October 22, 2009 at 7:14 am

    It would be simpler, I would think, to create the query without parameters and then add the parameters to the resulting derived table. I might be missing something here...

  8. sam says:
    October 26, 2009 at 5:24 am

    Colin,
    I thought of the same thing... Why build the parameters in Access if your Reporting is going to take place in Excel...Easier to build the parameters in Excel

  9. Matt says:
    October 27, 2009 at 11:19 pm

    This is one of the more broken down explanations I have found. I am still some what of a beginner when it comes to macros, specially when it comes to db stuff. But I have a question. What if I have a whole range of parameters to query under one field? I would still like to use the wildcard.

  10. datapig says:
    October 28, 2009 at 2:10 am

    Matt: You can set up your Access queries so that wildcards are part of the query.

    For example, you can use this as the criteria:

    LIKE "*" & [Enter Region & "*"

    When you pass the parameter from Excel, the wild cards will automatically wrap your parameter.

  11. Matt says:
    October 28, 2009 at 3:41 pm

    The wildcards are not the issue. I do have that set up. Its querying the multiple parameters for the one field. I just mentioned the wildcard in case the solution was to combine the parameters.

  12. Russ says:
    October 29, 2009 at 6:02 pm

    I have an Access report that uses a parameter query. Is it possible to use a vba procedure to pass the parameter values and open the report without prompts?

  13. datapig says:
    November 2, 2009 at 7:12 am

    Russ: Just use the code here and replace the Range parameters in Step 3 with the hard-coded values you need.

  14. b. adamczyk says:
    November 3, 2009 at 5:06 am

    Hi i was wondering how much you would to set your blog design up on my internet site for me, because i really like the look of your internet site but i don't know how to set such a hot design.

  15. Ed says:
    November 6, 2009 at 8:14 pm

    Hey thanks for the code, it was really helpful with what I'm working on. I'm trying to do the same thing now, but the parameter query I want to run is a query of 2 other queries. It asks for 2 parameters just like the others, but it does not return the data I need, just the column headers. This query works in Access. Any suggestions? Thank you.

  16. Lee says:
    November 24, 2009 at 7:27 pm

    Hi there,

    Thank you very much for the code provided, it was proven to be the best step forward I've had with these parameter queries from access to excel!

    It's great that the data is being transfered over, but my solution goes a bit further than this. Due to the amount of rows that I'm sending over from Access I require this data to be put in a pivot table, instead of just manually transfered into Excel.

    Any further help would be very much appreciated!

  17. datapig says:
    November 25, 2009 at 6:23 pm

    Lee: Can you not build your pivot table on top of the query results?

    If you do, you can add a line of code to refresh the pivot table every time the query updates.

  18. Jessie says:
    December 2, 2009 at 12:13 am

    I am new to VBA, but I've followed this so far and i am producing an error and don't know where to go from here:
    the error is at the .parameters..."item in the collection could not be found".

    What have I done wrong? Thanks

  19. datapig says:
    December 2, 2009 at 11:50 pm

    Jessie: Sounds like you're pointing to a query or table that doesn't exist.

    Probably in the line

    MyDatabase.QueryDefs("MyParameterQuery")

    Be sure to replace MyParameterQuery with your query name.

  20. Jessie says:
    December 3, 2009 at 4:32 pm

    Thanks datapig,
    but no, i did add my query name.
    I believe that I am not connecting to my database. When I run a debug from the beginning it says (1) "set MyDatabase = nothing"
    (2) "set myqueryDef = nothing"
    (3) it halts at ".parameter = "nothing in collection"

    'Step 2: Identify the database and query
    Set MyDatabase = DBEngine.OpenDatabase _
    ("\\hous0205\bps_data2\25257\Reports\BPSInventoryReports.Mdb")
    Set MyQueryDef = MyDatabase.QueryDefs("qryDailyReceivingLog - Duke - Revised")

  21. Jessie says:
    December 3, 2009 at 4:38 pm

    1) Also my query prompts for a date between a certain date. I am not sure how to set step 3 correctly for the parameter.

    Example: I need it to bring up data between [this date] and [that date] and it suppose to display the data for me.

    2) Also, for the run Paramater query button, did you add the code to it's property? I don't know how to make that button work.

    here is my code after I changed the information:
    Sub RunParameterQuery()

    'Step 1: Declare your variables
    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Dim i As Integer

    'Step 2: Identify the database and query
    Set MyDatabase = DBEngine.OpenDatabase _
    ("\\hous0205\bps_data2\25257\Reports\BPSInventoryReports.Mdb")
    Set MyQueryDef = MyDatabase.QueryDefs("qryDailyReceivingLog - Duke - Revised")

    'Step 3: Define the Parameters
    With MyQueryDef
    .Parameters("[ENTER start DATE] and [Enter end date]") = Range("B7").Value

    End With

    'Step 4: Open the query
    Set MyRecordset = MyQueryDef.OpenRecordset

    'Step 5: Clear previous contents
    Sheets("Main").Select
    ActiveSheet.Range("A7:K10000").ClearContents

    'Step 6: Copy the recordset to Excel
    ActiveSheet.Range("A7").CopyFromRecordset MyRecordset

    'Step 7: Add column heading names to the spreadsheet
    For i = 1 To MyRecordset.Fields.Count
    ActiveSheet.Cells(11, i).Value = MyRecordset.Fields(i - 1).Name
    Next i

    MsgBox "Your Query has been Run"

    End Sub

  22. datapig says:
    December 3, 2009 at 8:16 pm

    Jessie: In your code, step three looks like

    With MyQueryDef
    .Parameters("[ENTER start DATE] and [Enter end date]") = Range("B7").Value
    End With

    You can't have start date and end date coming from the same cell. Try this.

    With MyQueryDef
    .Parameters("[ENTER start DATE]") = Range("B6").Value
    .Parameters("[Enter end DATE]") = Range("B7").Value
    End With

    Make the start date come from cell B6 and end date come from cell B7,

    As far as connecting to your databae, be sure you have access to the database.

  23. Doran says:
    December 5, 2009 at 3:43 am

    Why attempt to update a pivot table from the data returned from the parameterize query, when a parameterize pivot table is really what you want?

  24. Kurtis says:
    December 11, 2009 at 12:15 am

    thanks, dadapig. this is exactly what i needed. works perfectly!!!

  25. dave says:
    January 8, 2010 at 6:37 pm

    Can you please tell me how to to this?
    Note: You will need to add a reference to the Microsoft DAO XX Object Library (where XX represents the latest version you have) .
    Is it another line of code?I keep getting complie error -user defined type not defined on this line: (MyDatabase As DAO.Database)
    thanks

  26. dave says:
    January 8, 2010 at 6:42 pm

    here is my code
    Sub RunParameterQuery()

    'Step 1: Declare your variables
    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Dim i As Integer

    'Step 2: Identify the database and query
    Set MyDatabase = DBEngine.OpenDatabase _
    ("\\lm-file-dfs-01\central\Commkt\Production\LMG-Property\File-Cabinet\LM Equipment Breakdown\Middle Market Tracking\Database\Middle Market Tracking System_be")
    Set MyQueryDef = MyDatabase.QueryDefs("SearchPades")

    'Step 3: Define the Parameters
    With MyQueryDef
    .Parameters("[Enter Policy]") = Range("D3").Value
    End With

    'Step 4: Open the query
    Set MyRecordset = MyQueryDef.OpenRecordset

    'Step 5: Clear previous contents
    Sheets("Main").Select
    ActiveSheet.Range("A6:K10000").ClearContents

    'Step 6: Copy the recordset to Excel
    ActiveSheet.Range("A7").CopyFromRecordset MyRecordset

    'Step 7: Add column heading names to the spreadsheet
    For i = 1 To MyRecordset.Fields.Count
    ActiveSheet.Cells(6, i).Value = MyRecordset.Fields(i - 1).Name
    Next i

    MsgBox "Your Query has been Run"

    End Sub

  27. datapig says:
    January 8, 2010 at 7:31 pm

    Dave: In the Visual Basic Editor,

    Go up to the toolbar and select Tools ->References.

    This will bring up the references dialog box.

    Go down the list and find the Microsoft DAO XX Object Library (where XX represents the latest version you have).

    When you find it, place a check next to it then press OK.

    This will added the needed reference.

  28. dave says:
    January 8, 2010 at 9:11 pm

    thanks works great

  29. dave says:
    January 8, 2010 at 11:21 pm

    Can you help with this one?
    How would I plug this parameter into the format you provided? I am getting runtime 13 -mismatch

    Like "*" & [] & "*" -error

    .Parameters("[Enter Policy Number]") = Range("b3").Value

  30. dave says:
    January 8, 2010 at 11:22 pm

    .Parameters("[Like "*" & [] & "*"]") = Range("b3").Value

    here is what I am trying to do

  31. datapig says:
    January 9, 2010 at 12:05 am

    Dave: Don't feed the LIKE operator through VBA. Build the like operator into your query.

    For example, put this into the query criteria: Like "*" & [Param1] & "*"

    Then just use .Parameters("[Param1]") Range("D3").Value

    The LIKE operator will be applied on the Query side.

  32. deewan says:
    January 19, 2010 at 12:45 am

    Just dropping a note to thank you. This code worked and completley saved a huge workaround for me.

  33. Darrell Martin says:
    January 20, 2010 at 7:17 pm

    I am stuck on a VB code I have that worked in 32 bit excel but does not work in 64 bit excel. I remove the soap client i was using at it is no longer supported and replaced it with MSXML

    when I try to run the code I receive the following error

    when I run the start client I get the attached error message
    Compile Error: User Defined Type Not Defined
    and then it goes to the Dim objHttp As MSXML.XMLHTTPRequest
    (Note I also tried the MSXML.ServerXMLHTTPRequest and received the same error).

  34. Darrell Martin says:
    January 20, 2010 at 7:22 pm

    Any help would be greatly appreciated!
    NOTE: I have tried adding the Microsoft XML 3.0, 4.0 and 6.0 reference library all resulting in the same error.
    Below is my code:

    PLAIN TEXT
    Visual Basic:
    1. Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
    2.     Dim uname As String
    3.     Dim LogID As String
    4.     Dim isloggedin As Integer
    5.     Dim refreshrate As String
    6.     Dim isinitialized As Integer
    7.     Dim allowedMarkets As String
    8.     Dim alwdmktids() As String
    9.     Dim MktCells() As String
    10.     Dim MktColss() As String
    11.     Dim MktNames() As String
    12.     Dim MktTitles() As String
    13.     Dim MktCGreater() As String
    14.     Dim MktCLesser() As String
    15.     Dim MktLimitLess() As String
    16.     Dim MktLimitGreat() As String
    17.     Dim MktLimitEqual() As String
    18.     Dim MktColorString() As String
    19.     Dim MktColorLess() As String
    20.     Dim MktColorGreat() As String
    21.     Dim MktColorEqual() As String
    22.     Dim MktColorLess2() As String
    23.     Dim MktColorHeader() As String
    24.     Dim MktColorRowHeader() As String
    25.     Dim MktColorColHeader() As String
    26.     Dim MktColorColString() As String
    27.     Dim conditionsloaded As Integer
    28.     Dim clearcondition As String
    29.     Dim firsttime As Integer
    30.     Dim delsheetid As Integer
    31.     Dim delsheetcell As Integer
    32.     Dim ConExecting
    33.     Dim Cond_with_Market
    34.     Dim TheConditionString As String
    35.     Dim objHTTP As MSXML.XMLHTTPRequest
    36.     Public Const SND_ASYNC = &H1
    37.     Public Const SND_SYNC = &H0
    38.     Public Const SND_LOOP = &H8
    39.     Dim conditions_are_true As Integer
    40.     Dim Old_Mkt_Values() As String
    41.        
    42.    
    43.    
    44.     Public Sub startclient()
    45.     On Error GoTo Handler
    46.     If isinitialized  1 Then
    47.     Set objHTTP = New MSXML.XMLHTTPRequest
    48.     objHTTP.Open “post”, "http://networksmarter.com/WebService.asmx?WSDL"
    49.     objHTTP.setRequestHeader “Content - Type”, ”text / xml”
    50.     Sheets(1).Cells(16, 6) = "Please login to get signals"
    51.     isinitialized = 1
    52.     End If
    53.     Exit Sub
    54. Handler:
    55.     Sheets(1).Cells(16, 6) = "XML client not initialized with the server"
    56.     Exit Sub
    57.     End Sub
    58.    
    59.     Public Sub stopclient()
    60.     Sheets(1).Cells(16, 6) = "Disconnected"
    61.     End Sub
    62.    
    63.     Public Sub AttachedNodes()
    64.     If IsEmpty(ConExecting) Then
    65.     ReDim ConExecting(0) As Integer
    66.     ConExecting(UBound(ConExecting)) = 0
    67.     Else
    68.     ReDim Preserve ConExecting(UBound(ConExecting) + 1)
    69.     ConExecting(UBound(ConExecting)) = 0
    70.     End If
    71.     ReDim Preserve ConExecting(UBound(ConExecting) + 1)
    72.     ConExecting(UBound(ConExecting)) = 0
    73.     End Sub
    74.    
    75.      
    76.  
    77.    
    78.     Public Function login()
    79.     On Error GoTo Handler
    80.     If isinitialized = 1 Then
    81.     Dim str As String
    82.     str = objHTTP.LoginUserSite(Sheets(1).txtUsername.Text, Sheets(1).txtPassword.Text, "")
    83.     conditions_are_true = 0
    84.     If (InStr(str, "Done")) Then
    85.     Dim sarrtyn() As String
    86.     sarrtyn = Split(str, "~")
    87.     LogID = sarrtyn(1)
    88.     firsttime = 1
    89.     uname = Sheets(1).txtUsername.Text
    90.     Sheets(1).Cells(16, 6) = "Connected"
    91.     Sheets(1).ButtonLogin.Caption = "Disconnect"
    92.     Call objHTTP.checkuser(uname, LogID)
    93.     isloggedin = 1
    94.     CollectAllowedMarkets
    95.     'refreshrate = "00:00:04"
    96.     'Application.OnTime EarliestTime:=Now + TimeValue(refreshrate), Procedure:="RefreshValues"
    97.     oprprog = 0
    98.     Else
    99.     Sheets(1).Cells(16, 6) = str
    100.     End If
    101.     End If
    102.     Exit Function
    103. Handler:
    104.     End Function
    105.        
    106.     Public Function logout()
    107.     If isloggedin = 1 Then
    108.     Call objHTTP.LogoutUser(uname, LogID)
    109.     Sheets(1).ButtonLogin.Caption = "Connect"
    110.     Sheets(1).Cells(16, 6) = "Not Connected"
    111.     uname = ""
    112.     isloggedin = 0
    113.     Application.DisplayAlerts = False
    114.     For i = 2 To Sheets.Count
    115.     Sheets(2).Delete
    116.     Next
    117.     Application.DisplayAlerts = True
    118.     End If
    119.     End Function
    120.    
    121.     Public Function CollectAllowedMarkets()
    122.     allowedMarkets = objHTTP.allowedMarkets(uname)
    123.     alwdmktids = Split(allowedMarkets, "~")
    124.     'Old_Mkt_Values = Split(allowedMarkets, "~")
    125.    
    126.     MktCells = alwdmktids
    127.     MktCols = alwdmktids
    128.     MktNames = alwdmktids
    129.     MktTitles = alwdmktids
    130.     MktCGreater = alwdmktids
    131.     MktCLesser = alwdmktids
    132.    
    133.     MktLimitLess = alwdmktids
    134.     MktLimitGreat = alwdmktids
    135.     MktLimitEqual = alwdmktids
    136.     MktColorLess = alwdmktids
    137.     MktColorLess2 = alwdmktids
    138.     MktColorGreat = alwdmktids
    139.     MktColorEqual = alwdmktids
    140.     MktColorString = alwdmktids
    141.     MktColorHeader = alwdmktids
    142.     MktColorRowHeader = alwdmktids
    143.     MktColorColHeader = alwdmktids
    144.     MktColorColString = alwdmktids
    145.    
    146.     For i = 0 To UBound(alwdmktids)
    147.     Dim str As String
    148.     str = objHTTP.MarketColors(uname, alwdmktids(i))
    149.     Dim strarr() As String
    150.     strarr = Split(str, "~")
    151.     MktCells(i) = strarr(0)
    152.     MktCols(i) = strarr(1)
    153.     MktNames(i) = strarr(2)
    154.     MktTitles(i) = strarr(3)
    155.     MktCGreater(i) = strarr(4)
    156.     'MsgBox MktCGreater(i)
    157.     MktCLesser(i) = strarr(5)
    158.     'MsgBox MktCLesser(i)
    159.    
    160.     MktColorGreat(i) = strarr(6)
    161.     MktColorLess(i) = strarr(7)
    162.     MktColorEqual(i) = strarr(8)
    163.     MktColorLess2(i) = strarr(9)
    164.     MktColorString(i) = strarr(10)
    165.     MktColorHeader(i) = strarr(11)
    166.    
    167.     MktLimitGreat(i) = strarr(12)
    168.     MktLimitLess(i) = strarr(13)
    169.     MktLimitEqual(i) = strarr(14)
    170.     MktColorColHeader(i) = strarr(15)
    171.     MktColorRowHeader(i) = strarr(16)
    172.     MktColorColString(i) = strarr(17)
    173.    
    174.    
    175.    
    176.     Sheets.Add After:=Sheets(Sheets.Count)
    177.     ActiveSheet.Name = MktNames(i)
    178.     'ActiveSheet.Name = "Sheet" + CStr(i + 8)
    179.     Sheets(i + 2).Cells(1, 1) = MktNames(i)
    180.     Sheets(i + 2).Cells(3, 1) = "Custom Fields"
    181.     Sheets(i + 2).Cells(3, 3) = MktTitles(i)
    182.     Dim colcordnates() As String
    183.     colcordnates = Split(MktColorHeader(i), "|")
    184.     Sheets(i + 2).Cells(3, 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    185.     With Sheets(i + 2).Range("C3:H3")
    186.     .Merge Across:=True
    187.     End With
    188.     Dim Formuid As Integer
    189.     Formuid = ((CInt(alwdmktids(i)) - 1) * 5)
    190.     For j = 1 To 5
    191.     str = objHTTP.GetFormula(uname, Formuid + j)
    192.     Dim avarSplit() As String
    193.     If (str  "") Then
    194.     Dim thecol As String
    195.     thecol = ""
    196.     avarSplit = Split(str, "~")
    197.     For ii = 0 To UBound(avarSplit)
    198.     If ii Mod 2 = 0 Then
    199.     If InStr(avarSplit(ii), "c") = 0 Then
    200.     Dim rownum As Integer
    201.     rownum = CInt(avarSplit(ii)) \ CInt(MktCols(i))
    202.     rownum = rownum + 4
    203.     Dim colnum As Integer
    204.     colnum = CInt(avarSplit(ii)) Mod CInt(MktCols(i))
    205.     thecol = thecol & Chr(67 + colnum) & CStr(rownum)
    206.     Else
    207.     thecol = thecol & Mid(avarSplit(ii), 2, Len(avarSplit(ii)))
    208.     End If
    209.     Else
    210.     thecol = thecol & avarSplit(ii)
    211.     End If
    212.     Next ii
    213.     Sheets(i + 2).Cells(j + 3, 1) = "=" & thecol
    214.     End If
    215.     Next j
    216.     Next i
    217.     refreshrate = "00:00:02"
    218.     conditionsloaded = 0
    219.     RefreshValues
    220.     End Function
    221.    
    222. Public Sub CollectConditions()
    223. For ii = 0 To UBound(alwdmktids)
    224. Dim Formuids() As String
    225. Dim formus As String
    226. formus = objHTTP.GetCustomFormulaIDs(uname, alwdmktids(ii))
    227.     If formus  "" Then
    228.             Formuids = Split(formus, "~")
    229.             Dim i, j, k As Integer
    230.             j = 0
    231.             For i = 0 To UBound(Formuids)
    232.             formus = objHTTP.GetCustomFormula(uname, Formuids(i))
    233.             Dim TempFOrmu() As String
    234.             TempFOrmu = Split(formus, "|")
    235.             Dim funparts() As String
    236.             funparts = Split(TempFOrmu(0), "~")
    237.             Dim tempcondition As String 'this condition would be installed
    238.             tempcondition = "=TestExec("
    239.            
    240.             TheConditionString = MktNames(ii) & ": "
    241.             For k = 0 To UBound(funparts) 'left side
    242.             If InStr(funparts(k), "formu") = 0 Then 'the formula field is there then false
    243.             If k Mod (2) = 1 Then
    244.             tempcondition = tempcondition + funparts(k)
    245.             TheConditionString = TheConditionString + CStr(k)
    246.             Else
    247.             TheConditionString = TheConditionString + "cell" + funparts(k)
    248.             Dim rownum As Integer
    249.             rownum = CInt(funparts(k)) \ CInt(MktCols(ii))
    250.             rownum = rownum + 4
    251.             Dim colnum As Integer
    252.             colnum = CInt(funparts(k)) Mod CInt(MktCols(ii))
    253.             tempcondition = tempcondition + Chr(67 + colnum) + CStr(rownum)
    254.             End If
    255.             Else
    256.             Select Case funparts(k)
    257.                 Case "formu1"
    258.                 tempcondition = tempcondition + "A4"
    259.                 TheConditionString = TheConditionString + "Custom 1"
    260.                 Case "formu2"
    261.                 tempcondition = tempcondition + "A5"
    262.                 TheConditionString = TheConditionString + "Custom 2"
    263.                 Case "formu3"
    264.                 tempcondition = tempcondition + "A6"
    265.                 TheConditionString = TheConditionString + "Custom 3"
    266.                 Case "formu4"
    267.                 tempcondition = tempcondition + "A7"
    268.                 TheConditionString = TheConditionString + "Custom 4"
    269.                 Case Else
    270.                 tempcondition = tempcondition + "A8"
    271.                 TheConditionString = TheConditionString + "Custom 5"
    272.                 End Select
    273.             End If
    274.             Next 'Left side condition
    275.            
    276.             If TempFOrmu(1) = "==" Then
    277.             tempcondition = tempcondition + ", ""="", "
    278.             TheConditionString = TheConditionString + " == "
    279.             Else
    280.             tempcondition = tempcondition + ", """ + TempFOrmu(1) + """, "
    281.             TheConditionString = TheConditionString + " " + TempFOrmu(1) + " "
    282.             End If 'Condition added
    283.             funparts = Split(TempFOrmu(2), "~")
    284.             For k = 0 To UBound(funparts) 'right side
    285.             If InStr(funparts(k), "formu") = 0 Then 'the formula field is there then false
    286.             If k Mod (2) = 1 Then
    287.             tempcondition = tempcondition + funparts(k)
    288.             TheConditionString = TheConditionString + funparts(k)
    289.             Else
    290.             TheConditionString = TheConditionString + "cell" + funparts(k)
    291.             rownum = CInt(funparts(k)) \ CInt(MktCols(ii))
    292.             rownum = rownum + 4
    293.             colnum = CInt(funparts(k)) Mod CInt(MktCols(ii))
    294.             tempcondition = tempcondition + Chr(67 + colnum) + CStr(rownum)
    295.             End If
    296.             Else
    297.             Select Case funparts(k)
    298.                 Case "formu1"
    299.                 tempcondition = tempcondition + "A4"
    300.                 TheConditionString = TheConditionString + "Custom 1"
    301.                 Case "formu2"
    302.                 tempcondition = tempcondition + "A5"
    303.                 TheConditionString = TheConditionString + "Custom 2"
    304.                 Case "formu3"
    305.                 tempcondition = tempcondition + "A6"
    306.                 TheConditionString = TheConditionString + "Custom 3"
    307.                 Case "formu4"
    308.                 tempcondition = tempcondition + "A7"
    309.                 TheConditionString = TheConditionString + "Custom 4"
    310.                 Case Else
    311.                 tempcondition = tempcondition + "A8"
    312.                 TheConditionString = TheConditionString + "Custom 5"
    313.                 End Select
    314.             End If
    315.             Next 'Right side condition
    316.            
    317.             'check if the condition is already executing
    318.             If IsEmpty(ConExecting) Then
    319.             ReDim ConExecting(0) As Integer
    320.             ReDim Cond_with_Market(0) As String
    321.             ConExecting(UBound(ConExecting)) = 0
    322.             Cond_with_Market(UBound(Cond_with_Market)) = TheConditionString
    323.             Else
    324.             ReDim Preserve ConExecting(UBound(ConExecting) + 1)
    325.             ReDim Preserve Cond_with_Market(UBound(Cond_with_Market) + 1)
    326.             ConExecting(UBound(ConExecting)) = 0
    327.             Cond_with_Market(UBound(Cond_with_Market)) = TheConditionString
    328.             End If
    329.            
    330.             tempcondition = tempcondition + ", """ + TempFOrmu(3) + """, """ + Formuids(i) + """," + CStr(4 + j) + ", " + CStr(ii + 2) + ", " + CStr(UBound(ConExecting)) + ", "" " + TempFOrmu(4) + " """ + ")"
    331.             'tempcondition = tempcondition + ", """ + TempFOrmu(3) + """, """ + Formuids(i) + """," + CStr(4 + j) + ", " + CStr(ii + 2) + ", " + CStr(UBound(ConExecting)) + ")"
    332.             Sheets(ii + 2).Cells(4 + j, 2) = tempcondition
    333.             tempcondition = ""
    334.             j = j + 1
    335.             Next i
    336.     End If
    337. Next ii
    338.  
    339. Exit Sub
    340. End Sub
    341.        
    342.    
    343.     Public Sub RefreshValues()
    344. On Error GoTo Handler
    345.     MousePointer = vbNormal
    346.     If Sheets(1).ButtonLogin.Caption  "Connect" Then
    347.     Dim colcordnates() As String
    348.     For i = 0 To UBound(alwdmktids)
    349.     Dim str As String
    350.     str = objHTTP.CollectInfoMarketNew(uname, alwdmktids(i), LogID)
    351.     'If Not Old_Mkt_Values(i) = str Then
    352.         'Old_Mkt_Values(i) = str
    353.         Dim avarSplit() As String
    354.         avarSplit = Split(str, "~")
    355.         Dim ii, j, k As Integer
    356.         j = 6
    357.         k = 0
    358.         Dim totrows As Integer
    359.         totrows = CInt(MktCells(i)) \ CInt(MktCols(i))
    360.         If UBound(avarSplit) + 1>= CInt(MktCells(i)) Then
    361.             For ii = 0 To totrows - 1
    362.                 For j = 0 To CInt(MktCols(i)) - 1
    363.                     If IsNumeric(avarSplit(k)) And avarSplit(k)  "" Then
    364.                     If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3), MktLimitLess(i), ">=") Then
    365.                         colcordnates = Split(MktColorLess(i), "|")
    366.                         Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    367.                     End If
    368.                     If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3), MktLimitEqual(i), ">=") Then
    369.                         colcordnates = Split(MktColorEqual(i), "|")
    370.                         Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    371.                     End If
    372.                     If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3), MktLimitGreat(i), ">=") Then
    373.                         colcordnates = Split(MktColorGreat(i), "|")
    374.                         Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    375.                     End If
    376.                     If CheckValueOp(Sheets(i + 2).Cells(ii + 4, j + 3), MktLimitLess(i), "<") Then
    377.                         colcordnates = Split(MktColorLess2(i), "|")
    378.                         Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    379.                     End If
    380.                         If Sheets(i + 2).Cells(ii + 4, j + 3)  avarSplit(k) Then
    381.                             If chkLess(Sheets(i + 2).Cells(ii + 4, j + 3), avarSplit(k)) Then
    382.                                 colcordnates = Split(MktCGreater(i), "|")
    383.                                 Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    384.                             Else
    385.                                 colcordnates = Split(MktCLesser(i), "|")
    386.                                 Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    387.                             End If
    388.                             Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
    389.                         End If
    390.                     Else
    391.                         If avarSplit(k) = "" Then
    392.                             Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(255, 255, 255)
    393.                             Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
    394.                         Else
    395.                             colcordnates = Split(MktColorString(i), "|")
    396.                             Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    397.                             Sheets(i + 2).Cells(ii + 4, j + 3) = avarSplit(k)
    398.                         End If
    399.                     End If
    400.                     If k Mod CInt(MktCols(i)) = 0 Then
    401.                     colcordnates = Split(MktColorRowHeader(i), "|")
    402.                     Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    403.                     End If
    404.                     If k <CInt(MktCols(i)) Then
    405.                     colcordnates = Split(MktColorColHeader(i), "|")
    406.                     Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    407.                     End If
    408.                     If avarSplit(k) = "" Then
    409.                     colcordnates = Split(MktColorColString(i), "|")
    410.                     Sheets(i + 2).Cells(ii + 4, j + 3).Interior.Color = RGB(CInt(colcordnates(0)), CInt(colcordnates(1)), CInt(colcordnates(2)))
    411.                     End If
    412.                     k = k + 1
    413.                 Next j
    414.             Next ii
    415.         End If
    416.     'End If
    417.     Next i
    418.     If conditionsloaded = 1 Then
    419.     Application.OnTime EarliestTime:=Now + TimeValue(refreshrate), Procedure:="RefreshValues"
    420.     Else
    421.     If firsttime = 1 Then
    422.     CollectConditions
    423.     Application.OnTime EarliestTime:=Now + TimeValue(refreshrate), Procedure:="RefreshValues"
    424.     conditionsloaded = 1
    425.     Else
    426.     Sheets(delsheetid).Cells(delsheetcell, 2) = ""
    427.     Application.OnTime EarliestTime:=Now + TimeValue(refreshrate), Procedure:="RefreshValues"
    428.     conditionsloaded = 1
    429.     firsttime = 1
    430.     End If
    431.     End If
    432.     End If
    433.     Exit Sub
    434. Handler:
    435. Application.OnTime EarliestTime:=Now + TimeValue(refreshrate), Procedure:="RefreshValues"
    436. Exit Sub
    437.     End Sub
    438.    
    439.     Public Function TestExec(lftsde, cditon, rhtsde, opration, Formuid, ClearCellid, ClearSheetid, FormulaIndex, cond_text_sp)
    440.     TestExec = "Alert Not Triggered"
    441.     If Evaluate(lftsde & cditon & rhtsde) Then
    442.     If ConExecting(FormulaIndex) = 0 Then
    443.         If opration = "1" Then
    444.             Call objHTTP.SendAlert(uname, Cond_with_Market(FormulaIndex), Formuid)
    445.             TestExec = "Alert Triggered"
    446.         Else
    447.             If conditions_are_true = 0 Then
    448.                 Call sndPlaySound32("C:\Program Files\Signal System Client\success.wav", SND_ASYNC + SND_LOOP)
    449.             End If
    450.             conditions_are_true = conditions_are_true + 1
    451.             If opration = "2" Then
    452.                 Call objHTTP.Event_Log(uname, Cond_with_Market(FormulaIndex), "", "Play alarm")
    453.             Else
    454.                 Call objHTTP.Event_Log(uname, Cond_with_Market(FormulaIndex), cond_text_sp, "Timer")
    455.             End If
    456.             TestExec = "Alert Triggered"
    457.         End If 'the condition whether operation is 1 or other
    458.         ConExecting(FormulaIndex) = 1
    459.     Else
    460.         If opration  "1" Then
    461.             'Call sndPlaySound32("C:\Program Files\Signal System Client\success.wav", SND_ASYNC + SND_LOOP)
    462.             TestExec = "Alert Triggered"
    463.         End If
    464.     End If 'already executing operation or not
    465.     Else
    466.     If ConExecting(FormulaIndex) = 1 Then
    467.         ConExecting(FormulaIndex) = 0
    468.         conditions_are_true = conditions_are_true - 1
    469.         If conditions_are_true = 0 Then
    470.         Call sndPlaySound32("C:\Program Files\Signal System Client\none.wav", 1)
    471.     End If
    472.     End If
    473.     End If 'end of evaluation
    474.     End Function
    476.     Public Function CheckValueOp(leftvalue, rightvalue, compoperator) As Boolean
    477.     On Error GoTo Handler
    478.     If compoperator = "==" Then
    479.         If CDbl(leftvalue) = CDbl(rightvalue) Then
    480.         CheckValueOp = True
    481.         Else
    482.         CheckValueOp = False
    483.         End If
    484.         Exit Function
    485.     End If
    486.    
    487.     If compoperator = "<" Then
    488.         If CDbl(leftvalue) =" Then
    489.         If CDbl(leftvalue)>= CDbl(rightvalue) Then
    490.         CheckValueOp = True
    491.         Else
    492.         CheckValueOp = False
    493.         End If
    494.         Exit Function
    495.     End If
    496. Handler:
    497.     CheckValueOp = False
    498.     End Function
    499.    
    500.     Public Function chkLess(frstvalu, scndvalu) As Boolean
    501.     On Error GoTo Handler
    502.     If CDbl(frstvalu) <CDbl(scndvalu) Then
    503.         chkLess = True
    504.     Else
    505.         chkLess = False
    506.     End If
    507.     Exit Function
    508. Handler:
    509.     chkLess = False
    510.     End Function

  35. datapig says:
    January 21, 2010 at 9:10 pm

    Darrel: Wow...you've got alot going on here.
    You'd have to give me a much simpler example than this.

  36. dave says:
    February 12, 2010 at 6:03 pm

    Hello
    Will this work using a runtime version of access?
    I have it working on full verison of access but im having trouble with the runtime version.

    thanks

  37. datapig says:
    February 12, 2010 at 6:37 pm

    Dave: Make sure you're referencing the database as an accdr.

    Set MyDatabase = DBEngine.OpenDatabase _
    ("C:\Integration\IntegrationDatabase.accdr")

  38. PCP69 says:
    February 15, 2010 at 7:39 pm

    Thanks, you made my day. Works a treat.

  39. tahoeast says:
    February 27, 2010 at 6:02 am

    I guess I am slow.. I get "Compile error: User-defined type not defined" on the first line "Dim MyDatabase As DAO.Database". And I don't really know what it means when you say "You will need to add a reference to the Microsoft DAO 12.0 [in my case] Object Library". Help & Thanks!

  40. Trish says:
    March 31, 2010 at 12:59 pm

    I am trying to run this code but get a 3343 run-time error message - unrecognizable database format? Help!

  41. datapig says:
    March 31, 2010 at 2:18 pm

    Trish: Make sure you're referencing the correct version of Access.

    If you're using Access 2003, you'll ned to use this:

    Set MyDatabase = DBEngine.OpenDatabase _
    ("C:\Integration\IntegrationDatabase.mdb")

  42. Trish says:
    March 31, 2010 at 3:10 pm

    Thanks for that but its Access 2007

  43. Trish says:
    March 31, 2010 at 3:20 pm

    Could it be something to do with References?

  44. Kelly says:
    June 30, 2010 at 10:13 am

    I am getting the following error:
    'Run-time error '3112':
    Record(s) cannot be read; no read permission on 'tblRequest'

    'tblRequest' is one of the table in my query.

    I am running Access and Office 2007. I have had to add a reference to: 'Microsoft Office 12.0 Access database engine object library' instead of 'Microsoft DAO 3.6 Object Library'

    Is there anything else I should be doing?

    Here is the top part of my query:

    Sub RunParameterQuery()

    'Step 1: Declare your variables
    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset

    Dim i As Integer

    'Step 2: Identify the database and query
    Set MyDatabase = DBEngine.OpenDatabase _
    ("\\lotus\data\Projects\Projects\Project Database\TaskManagerC.accde")

    Set Db = OpenDatabase("\\lotus\data\Projects\Projects\Project Database\TaskManagerC.accde")

    'Create a workspace with the correct login information
    Set MyQueryDef = MyDatabase.QueryDefs("kbQryTaskTimeTotalsByRequest")

    'Step 3: Define the Parameters
    With MyQueryDef
    .Parameters("[Enter Request]") = Range("C2").Value
    End With

  45. Stevan says:
    August 16, 2010 at 6:20 pm

    Hi,

    I just found a funny solution to this, which allows to avoid coding, and remains sufficiently clean if the reporting is stable and not too complicated.

    1. Create a XL sheet with your parameters (why not in the same workbook)

    1bis. If you want to enter data in the main dashboard sheet, put a formula into the parameter sheet that points to the dashboard sheet

    2. Go to access and make this sheet a linked table, with external data feature

    3. Then you can use this table in the parameter fields or formulas with a subquery.

    Works very nicely.

    Regards,
    Stevan

  46. Southhelm says:
    September 8, 2010 at 12:14 pm

    Thanks, saved a lot of time and added much to an ongoing project.

  47. Ghh says:
    October 1, 2010 at 6:55 pm

    Hi there ,

    Thanks for the code. I've been trying to run this but I keep getting a "Run time error '3219' Invalid operation' whenever I try to run it. My code is below. Please help ! :)

    Sub RunParameterQuery()
    'Step 1: Declare your variables
    Dim Defects_Master As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Dim i As Integer
    'Step 2: Identify the database and query
    Set Defects_Master = DBEngine.OpenDatabase _
    ("D:\Documents and Settings\e479196\Desktop\FPY & TPY\Defects_Master.mdb")
    Set MyQueryDef = Defects_Master.QueryDefs("qry_FPY_CustomDates")
    'Step 3: Define the Parameters
    With MyQueryDef
    .Parameters("[Enter Start Date]") = Range("C2").Value
    .Parameters("[Enter End Date]") = Range("C4").Value
    .Parameters("[Enter Cell Name]") = Range("C6").Value
    .Parameters("[Enter Material Number]") = Range("C8").Value
    End With
    'Step 4: Open the query
    Set MyRecordset = MyQueryDef.OpenRecordset
    'Step 5: Clear previous contents
    Sheets("Main").Select
    ActiveSheet.Range("A14:K10000").ClearContents
    'Step 6: Copy the recordset to Excel
    ActiveSheet.Range("A15").CopyFromRecordset MyRecordset
    'Step 7: Add column heading names to the spreadsheet
    For i = 1 To MyRecordset.Fields.Count
    ActiveSheet.Cells(14, i).Value = MyRecordset.Fields(i - 1).Name
    Next i
    MsgBox "Your Query has been Run"
    End Sub

  48. Ghh says:
    October 1, 2010 at 7:12 pm

    Ok so I actually figured it out. My original query was a make-table query so I just changed it to a Select query and it worked.

    However, the data that I really want to return is based on another query run based on the results of the new Select Parameter query.

    How can I do that ? Do I run a macro where I'm manually running the other query? Do you think that would work or is there another way?

    Thanks!

  49. Ghh says:
    October 1, 2010 at 7:36 pm

    I actually will need to keep the query as a make-table because otherwise the next query will not work since it references the table made by the parameter query. How can I make this work ?

    Basically I need to run two additional queries based on the results of the parameter query and then return the results to the user.

    Thanks

  50. datapig says:
    October 1, 2010 at 7:45 pm

    Ghh: You should be able to use this before running the parameter query.

    MyDatabase.Execute "MakeTableQuery1", dbFailOnError

    MyDatabase.Execute "MakeTableQuery2", dbFailOnError

Newer Comments »

Trackbacks/
Pingbacks

  1. Running an Access Parameter Query from Excel - Microsoft Access - Site Root - Telligent

Leave a Reply

Leave a Reply

Your email address will not be published. Required fields are marked *

*

* Copy this password:

* Type or paste password here:

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>