代码之家 › 专栏 › 技术社区 › The Dude MAN

VBA根据用户输入以全局方式更改查询SQL

ms-access vba

The Dude MAN · 技术社区 · 7 年前

我正在尝试创建一个宏,该宏基于用户输入(在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"));

2 回复 | 直到 7 年前

Parfait 7 年前

由于用户输入的大小是开放式的,请考虑使用MS Access中保存的具有精确结构的临时表作为查询(可以使用以下内容构建): SELECT * INTO temp_table FROM myquery )。然后,每次调用Excel宏时:

用清洁温度表 DELETE 。
遍历用户输入的Excel单元格范围,以将所需的行附加到表中 INSERT INTO...SELECT 。
从临时表创建记录集。

再一次,这里是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
.......

Parfait 7 年前

您显示的代码有一些问题。例如 斯特恩菲尔德 在您将其设置为任何值之前,尝试使用变量,如下所示:

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

在这一点上 斯特恩菲尔德 完全为空,但您正在尝试替换。

我建议:

改变你 WHERE\u字段 常量自

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() 陈述

现在要填充 斯特恩菲尔德 随他们提供的任何输入而变化。可能使用 Do While Loop 迭代输入。每个输入都添加到 斯特恩菲尔德 类似这样的变量。

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 & ")"

现在你有了 斯特恩菲尔德 填充您只需运行replace()
```
Replace(WHERE_FIELDS, "<INSERT FIELDS>", strNewFields)
```

迈克尔