1

I'm attempting to create a macro that based on a user input (on an excel sheet) will pull data from a query I made in Access. In order for it to pull only the applicable lines (rows) of data it needs to edit the WHERE statement accordingly. I have adapted the following code from a previous question but I am running into issues when I try to replace the SQL.

Private Sub CommandButton4_Click()
Const DbLoc As String = "MYfilepath"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim wb1 As Workbook, ws1 As Worksheet, ws2 As Worksheet, SQL As String, recCount As Long
Set wb1 = Workbooks("mytool.xlsm")
Set ws1 = wb1.Sheets("Inputs")
Set ws2 = wb1.Sheets("raw")
Set db = OpenDatabase(DbLoc)
Set userinput = ws1.Range("D6")


SQL = "SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID"
SQL = SQL & "FROM Dock_Rec_Problems;"
SQL = SQL & "WHERE [Dock_Rec_Problems_DGID] =" & userinput

Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
If rs.RecordCount = 0 Then
    MsgBox "Not found in database", vbInformation + vbOKOnly, "No Data"
    GoTo SubExit
End If

ws2.Range("A1").CopyFromRecordset rs

SubExit:
On Error Resume Next
    Application.Cursor = xlDefault
    rs.Close
    Set rs = Nothing
Exit Sub

End Sub

Let me know if there is anything I can clear up...thanks!

Original Query SQL

SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, 
Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, 
Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, 
Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, 
Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, 
Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems;

Single input SQL

SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000"));

Double input SQL

SELECT Dock_Rec_Problems.Merch_Name, Dock_Rec_Problems.Vendor_Error_Code, Dock_Rec_Problems.DC, Dock_Rec_Problems.Vendor_ID_IP, Dock_Rec_Problems.Vendor_Name, Dock_Rec_Problems.PO_Number, Dock_Rec_Problems.SKU_No, Dock_Rec_Problems.Item_Description, Dock_Rec_Problems.Casepack, Dock_Rec_Problems.Retail, Dock_Rec_Problems.Num_Of_Cases, Dock_Rec_Problems.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems
WHERE (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323000")) OR (((Dock_Rec_Problems.Dock_Rec_Problems_DGID)="D040323012"));
6
  • Can you more clearly explain what is the problem? What you are expecting to happen, what is actually happening? Commented May 15, 2018 at 21:38
  • Yes, so the error I am getting is on the line below my ' Replace the SQL comment. If a user puts D040323000 in a cell and runs my macro it should pull only a single row of data back to the worksheet. If a user inputs D040323000, D040323012 it should return two rows. Commented May 15, 2018 at 21:49
  • 2
    Shouldn't that be WHERE [column] IN ([comma-separated-values])? Also, Bobby Tables. Commented May 15, 2018 at 21:50
  • So I added what the SQL looks like when I manually edit it in access but is there a way I can have VBA do this for me based on the actual input from a user? Thanks' Commented May 15, 2018 at 22:00
  • What's the maximum number of selections you would expect to have? 10? Commented May 15, 2018 at 22:05

2 Answers 2

1

Because the size of your user input is open-ended, consider using a temp table saved in MS Access with exact structure as your query (can be built with: SELECT * INTO temp_table FROM myquery). Then, with each call of the Excel macro:

  1. Clean the temp table out with DELETE.
  2. Iterate through the user input Excel range of cells to append needed rows to table with INSERT INTO...SELECT.
  3. Create recordset from temp table.

And once again, here is a prime use case for SQL parameterization especially since the query receives user input. A clever, malicious user can potentially clean out your database! But at the very least, code is arguably more maintainable. Because you are using DAO, consider QueryDefs to bind parameter value to a prepared, saved query and then bind into a recordset.

SQL (save as an MS Access stored action query)

PARAMETERS [userparam] TEXT(255);
INSERT INTO Excel_Table (Merch_Name, Vendor_Error_Code, DC, Vendor_ID_IP,
                         Vendor_Name, PO_Number, SKU_No, Item_Description,
                         Casepack, Retail, Num_Of_Cases, Dock_Rec_Problems_DGID)
SELECT d.Merch_Name, d.Vendor_Error_Code, d.DC, d.Vendor_ID_IP, 
       d.Vendor_Name, d.PO_Number, d.SKU_No, d.Item_Description, 
       d.Casepack, d.Retail, d.Num_Of_Cases, d.Dock_Rec_Problems_DGID
FROM Dock_Rec_Problems d
WHERE d.[Dock_Rec_Problems_DGID] = [userparam];

VBA

...
Dim qdef As DAO.QueryDef
Dim cel As Range

Set qdef = db.QueryDefs("mySavedQuery")

' CLEAN OUT TEMP EXCEL TABLE
db.Execute "DELETE FROM Excel_Table"

' ITERATIVELY APPEND TO EXCEL TABLES
For Each cel In userinput.Cells
    qdef!userparam = cel.Value            ' BIND PARAM
    qdef.Execute dbFailOnError            ' EXECUTE ACTION
Next cel

' OPEN RECORDSET TO TABLE
Set rs = db.OpenRecordset("Excel_Table", dbOpenSnapshot)

If rs.RecordCount = 0 Then
    MsgBox "Recieving problem not found in database", vbInformation+vbOKOnly, "No Data"
    GoTo SubExit
End If

ws2.Range("A1").CopyFromRecordset rs
.......
Sign up to request clarification or add additional context in comments.

11 Comments

thanks for your answer. I'm having a little trouble saving the action query correctly (super bad with Access). Do you mind walking me through it? When I try to running your SQL a msg box says 'characters found after end of SQL statement.
Whoops! I accidentally had a premature semicolon. I removed it. Now save the SQL in the query design of MS Access (SQL mode). Be sure to have created Excel_Table beforehand.
Getting application defined error on set qdef = db.querydefs("myquery") line. Other saved queries work but the action query we saved for some reason gets this error... any ideas?
MS Access does not allow you to save a query with a syntax error. Are you sure the database has a query object named myquery fully saved? And I assume db is a DAO.Database.
it's actually named "RAG_query" and is correctly saved in the database. Something to note... When I try to run the action query (RAG_query) and enter a userparam manually, it says "the INSERT INTO statement contains the following unknown field name 'Vendor_Error_Code'
|
0

There are a few problems with the code you've displayed. For instance, the strNewFields variable is attempted to be used, before you've set it to anything, here:

strNewSQL = strNewSQL & Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)

At this point strNewFields is totally blank, but you're trying to do a replace.

I would suggest:

  1. Change you WHERE_FIELDS Const from

    Const WHERE_FIELDS As String = "WHERE " _
         & "(((Dock_Rec_Problems.Dock_Rec_Problems_DGID) = <INSERT FIELDS>)); "
    

    to

    Const WHERE_FIELDS As String = "WHERE " _ 
         & " [Dock_Rec_Problems].[Dock_Rec_Problems_DGID] IN (<INSERT FIELDS>); "
    

    I find this easier to read then all the nested brackets, it removes the equals sign in preference of the IN() statement.

  2. Now you want to populate the strNewFields variable with whatever inputs they gave you. Probably using a Do While Loop to iterate through the INPUTS. Each input is added to the strNewFields variable something like this.

    Dim rs as Recordset
    Set RS = currentdb.mydataset  ' You need to modify this line
    rs.Open
    strNewFields = strNewFields & "'" & rs("InputFieldName") & "'"
    rs.MoveNext
    
    Do While rs.EOF = False
        strNewFields = strNewFields & ",'" & rs("InputFieldName") & "'"
    Loop
    
    strNewFields = StrNewFields & ")"
    
  3. Now that you have strNewFields populated you can simply run your replace()

    Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
    

You need to look at the order in which you are setting variables though, as pointed out above, you've got some order of event issues.

Michael

5 Comments

OP is also going to have to remove strNewFields and the associated replace from BASIC_FIELDS
Working on the second part... currentdb.mydataset. Is this a reference to the Access DB as a whole or a specific table name?
@Mnathan: Okay so the currendb.mydataset part is referencing the INPUT table where you users get to say what indices they are looking for, and is just a sample as I don't know what your using. It probably should look more like : set rs = currentdb.OpenRecordset( italic_yourdatatablename_italic, dbOpenDynaset). Sorry, my formatting isn't working well on this question for some reason.
Ok thanks! so the user inputs are located on a worksheet. so something like set rs = ws1.Range("D6")? I'll also probably need to work in a split OP somewhere for when a delimiter is present but for now I'm just trying to get it to work with a single input.
@thespecial I changed my code to something I think would be easier to to solve. It also might be easier to tell what I am trying to accomplish. I still have the same end goal but what do you think about that? The error I am getting now is with my line Set rs = db.openrecordset(SQL, dbOpenSnapshot) Thank you for your help!

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.