VBA громадно меняет SQL запроса на основе пользовательского ввода

Question

Я пытаюсь создать макрос, который на основе пользовательского ввода (на листе Excel) будет извлекать данные из запроса, который я сделал в Access. Для того, чтобы он вытягивал только соответствующие строки (строки) данных, ему необходимо соответствующим образом отредактировать оператор WHERE. Я адаптировал следующий код из предыдущего вопроса, но у меня возникают проблемы, когда я пытаюсь заменить 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

Дайте мне знать, если я что-нибудь проясню ... спасибо!

Оригинальный запрос 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;

Однократный ввод 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"));

Двойной ввод 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"));

Answer 1

Поскольку размер вашего пользовательского ввода не ограничен, рассмотрите возможность использования временной таблицы, сохраненной в MS Access, с точной структурой в качестве вашего запроса (может быть построен с помощью: SELECT * INTO temp_table FROM myquery). Затем при каждом вызове макроса Excel:

1. Очистите временную таблицу с помощью DELETE.
2. Итерация по диапазону ячеек ввода пользователем в Excel для добавления необходимых строк в таблицу с помощью INSERT INTO...SELECT.
3. Создать набор записей из временной таблицы.

И еще раз, здесь приведен основной пример использования параметризации SQL, тем более что запрос получает пользовательский ввод. Умный, злонамеренный пользователь потенциально может очистить вашу базу данных! Но, по крайней мере, код, возможно, более удобен в обслуживании. Поскольку вы используете DAO, рассмотрите QueryDefs , чтобы связать значение параметра с подготовленным, сохраненным запросом, а затем связать с набором записей.

SQL (сохранить как запрос хранимого действия MS Access)

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 1026 *

...
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
.......

Answer 2

Есть несколько проблем с кодом, который вы отобразили.Например, переменная strNewFields пытается использоваться до того, как вы ее установили, здесь:

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

На данный момент strNewFields полностьюпусто, но вы пытаетесь сделать замену.

Я бы предложил:

1. Изменить вас WHERE_FIELDS Const с

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

   на

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

   Мне проще читать все вложенные скобки, он удаляет знак равенства в предпочтении оператора IN().

2. Теперь вы хотите заполнить поля strNewFields переменная с любыми данными, которые они вам дали.Вероятно, с помощью Do While Loop для перебора входов.Каждый вход добавляется в переменную strNewFields примерно так:

   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. Теперь, когда у вас заполнено strNewFields , вы можете просто запустить свойreplace ()

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

Вам нужно посмотреть порядок, в котором вы устанавливаете переменные, хотя, как указано выше, у вас есть некоторый порядок проблем с событиями.

Майкл