VBA根据用户输入全面更改查询SQL
我正在尝试创建一个基于用户输入(在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如果有什么我可以清除的up...thanks，请告诉我！
原始查询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"));回答 2
Stack Overflow用户
发布于 2018-05-17 04:24:40
由于用户输入的大小是开放的，请考虑使用保存在MS Access中的具有确切结构的临时表作为查询(可以使用：SELECT * INTO temp_table FROM myquery构建)。然后，每次调用Excel宏时：
通过用户输入的单元格区域，使用DELETE.
- Iterate清理临时表，以便使用临时表中的
INSERT INTO...SELECT.
- Create记录集将所需的行追加到表中。
同样，这里是SQL参数化的主要用例，特别是因为查询接收用户输入。聪明的恶意用户可能会清除您的数据库！但至少，代码可以说是更易维护的。由于您使用的是DAO，因此请考虑使用QueryDefs将参数值绑定到已准备好的、已保存的查询，然后再绑定到记录集中。
(另存为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
...
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
.......Stack Overflow用户
发布于 2018-05-16 07:15:16
您所显示的代码存在一些问题。例如，在将变量设置为任何值之前，尝试使用strNewFields变量，如下所示：
strNewSQL = strNewSQL & Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)在这一点上，strNewFields是完全空白的，但您正在尝试进行替换。
我建议：
- 将您的WHERE_FIELDS常量从
常量字符串As WHERE_FIELDS = "WHERE“_&”(Dock_Rec_Problems.Dock_Rec_Problems_DGID)= ))；“
至
常量字符串As WHERE_FIELDS = "WHERE“_&”Dock_Rec_Problems.Dock_Rec_Problems_DGID IN ()；“
我发现这比所有嵌套的括号更容易阅读，它去掉了等号，而不是IN()语句，
- 现在你想用他们给你的任何输入填充strNewFields变量。可能是使用
Do While Loop来迭代输入。每个输入都被添加到strNewFields变量中，如下所示。
Dim RS as记录集集rs = currentdb.mydataset‘您需要修改此行rs.Open strNewFields = strNewFields & "'“& rs("InputFieldName") & "'”rs.MoveNext Do While rs.EOF = False strNewFields = StrNewFields & "，'“& rs("InputFieldName") &”“循环strNewFields = strNewFields &”)“
- 现在您已经填充了strNewFields，您只需运行您的替换()
替换( strNewFields)，""，WHERE_FIELDS
您需要查看设置变量的顺序，但如上所述，您已经获得了一些事件问题的顺序。
迈克尔
https://stackoverflow.com/questions/50359305
复制相似问题