通过连接在Access VBA中构建WHERE IN SELECT子查询

时间：2018-04-11 18:53:37

标签： vba ms-access access-vba

我试图在Access 2016中为那些计算机知识最低的人建立一个库存分类和跟踪系统，并且我被要求将其缩小到一个搜索栏而不是单独的过滤器。经过相当多的讨论，我设法让一个工作，当我去为另一个部门复制设计时，它给我一个关于我的代码正在构建的SQL语句的语法错误。有效的格式完全相同，并且在通过在线验证器运行时返回相同的错误，但在实践中功能正常。

用户在文本框 MainSearch 中输入文本，该文本框构建搜索字符串（此处显示为 1155 等），并在{{1}上过滤表单结果事件。我很确定我可以在之前和之后管理调试，但我不能，对于我正在做的所有研究，找出我的SQL语法错误。我包含了它使用的其他功能，以防万一与我不了解的人相关。

AfterUpdate

这就是它的回报：

Function ExecuteSearch(strCriteria As String) As Boolean
On Error Goto Err_ExecuteSearch

Dim strSQL As String
Dim strSQLWhere As String
Dim lngCount As Long
Dim rst as Recordset

strCriteria = "*" & Me.MainSearch.Text & "*"
Trim (strCriteria)
strCriteria = Replace(strCriteria, "'", "")

strSQL = "SELECT * FROM REOEM"

strSQLWhere = "ID IN (SELECT ID FROM REOEM WHERE Manufacturer LIKE 'strCriteria' OR Type LIKE 'strCriteria' OR Make LIKE 'strCriteria' OR Lester LIKE 'strCriteria' " _
& "OR OEM1 LIKE 'strCriteria' OR OEM2 LIKE 'strCriteria' OR OEM3 LIKE 'strCriteria' OR OEM4 LIKE 'strCriteria' OR OEM5 LIKE 'strCriteria' OR OEM6 LIKE 'strCriteria' OR OEM7 LIKE 'strCriteria' OR OEM8 Like 'strCriteria' OR OEM9 Like 'strCriteria' OR OEM10 LIKE 'strCriteria' " _    
& "OR OEM11 LIKE 'strCriteria' OR OEM12 LIKE 'strCriteria' OR OEM13 LIKE 'strCriteria' OR OEM14 LIKE 'strCriteria' OR OEM15 LIKE 'strCriteria' OR OEM16 LIKE 'strCriteria' OR OEM17 LIKE 'strCriteria' OR OEM18 LIKE 'strCriteria' OR OEM19 LIKE 'strCriteria' OR OEM20 LIKE 'strCriteria' " _
& "OR OEM21 LIKE 'strCriteria' OR OEM22 LIKE 'strCriteria' OR OEM23 Like 'strCriteria' OR OEM24 LIKE 'strCriteria' OR OEM25 LIKE 'strCriteria' OR OEM26 LIKE 'strCriteria' OR OEM27 LIKE 'strCriteria' OR OEM28 LIKE 'strCriteria' OR OEM29 LIKE 'strCriteria' OR OEM30 LIKE 'strCriteria' " _
& "OR OEM31 LIKE 'strCriteria' OR OEM32 LIKE 'strCriteria' OR OEM33 LIKE 'strCriteria' OR OEM34 LIKE 'strCriteria' OR OEM35 LIKE 'strCriteria' OR OEM36 LIKE 'strCriteria' OR OEM37 LIKE 'strCriteria' OR OEM38 LIKE 'strCriteria' OR OEM39 LIKE 'strCriteria' OR OEM40 LIKE 'strCriteria' " _
& "OR OEM41 LIKE 'strCriteria' OR OEM42 LIKE 'strCriteria' OR OEM43 LIKE 'strCriteria' OR OEM44 LIKE 'strCriteria' OR OEM45 LIKE 'strCriteria' OR OEM46 LIKE 'strCriteria' OR OEM47 LIKE 'strCriteria' OR OEM48 LIKE 'strCriteria' OR OEM49 LIKE 'strCriteria' OR OEM50 LIKE 'strCriteria' " _
& "OR OEM51 LIKE 'strCriteria' OR OEM52 LIKE 'strCriteria' OR OEM53 LIKE 'strCriteria' OR OEM54 LIKE 'strCriteria' OR OEM55 LIKE 'strCriteria' OR OEM56 LIKE 'strCriteria' OR OEM57 LIKE 'strCriteria' OR OEM58 LIKE 'strCriteria' OR OEM59 LIKE 'strCriteria' OR OEM60 LIKE 'strCriteria' " _
& "OR OEM61 LIKE 'strCriteria' OR OEM62 LIKE 'strCriteria' OR OEM63 LIKE 'strCriteria' OR OEM64 LIKE 'strCriteria' OR OEM65 LIKE 'strCriteria' OR OEM66 LIKE 'strCriteria' OR OEM67 LIKE 'strCriteria' OR OEM68 LIKE 'strCriteria' OR OEM69 LIKE 'strCriteria' OR OEM70 LIKE 'strCriteria " _
& "OR OEM71 LIKE 'strCriteria' OR OEM72 LIKE 'strCriteria' OR OEM73 LIKE 'strCriteria' OR OEM74 LIKE 'strCriteria' OR OEM75 LIKE 'strCriteria' );"

strSQL = strSQL & " WHERE " & strSQLWhere

'Used for testing SQL String
'debug.print strSQL
lngCount = FindRecord(strSQL)
If lngCount = 0 Then
   ExecuteSearch = False
Else
   ExecuteSearch = True
   Set rst = me.RecordsetClone
   DoCmd.ApplyFilter (strSQL)
End If

Exit_ExecuteSearch:
   Exit Function

Err_ExecuteSearch:
   MsgBox Err.Description
   ExecuteSearch = False
   Resume Exit_ExecuteSearch
End Function




Function FindRecord(ByVal strSearchString As String) As Long
On Error GoTo Err_Findrecord

Dim dbSearch as DAO.Database
Dim rsSearch as DAO.Recordset

Set dbSearch = DBEngine.Workspaces(0).Databases(0)
Set rsSearch = dbSearch.OpenRecordset(strSearchString, dbOpenSnapshot)

With rsSearch
   If (.BOF and .EOF) Then
      FindRecord = 0
   Else
      .MoveLast
      FindRecord = .RecordCount
   End If
End With

Exit_FindRecord:
   rsSearch.Close
   dbSearch.Close
   Exit Function

Err_FindRecord:
   MsgBox Err.Description
   Resume Exit_FindRecord
End Function

非常感谢任何帮助。要温柔，我只有这个约一个月。大部分代码都是从在线资源中无耻地改编而来。

2 个答案:

答案 0 :(得分：1)

你确定这就是你得到的吗？因为据我所知

Manufacturer LIKE '" & strCriteria & "' OR...

应该是

Dim a As String
Dim b As String
a = "My Text"
b = "My text value is 'a'"

等

考虑这个例子：

My text value is 'a'

结果b为My text value is 'My Text'。不是{{1}}

答案 1 :(得分：1)

考虑使用参数化，这是MS Access之外的行业最佳实践，但是应用层代码中使用的所有数据库。这样做可以避免将VBA值连接到SQL代码，需要根据数据类型包装引号或主题标签或其他符号。即便如此，聪明的用户也可以在搜索框中写malicious code来破坏您的数据库。不要认为所有用户都最低限度的计算机知识！

MS Access SQL dialect允许PARAMETERS子句。然后在VBA中，使用QueryDef.Parameters将值绑定到命名参数。并使用其Recordset属性更新表单，其中零返回的行呈现为空表单。

SQL 查询（另存为MS Access存储查询） 

PARAMETERS strCriteriaParam Text (255);
SELECT * FROM REOEM
WHERE Manufacturer LIKE strCriteriaParam OR [Type] LIKE strCriteriaParam 
OR [Make] LIKE strCriteriaParam OR Lester LIKE strCriteriaParam     
OR OEM1 LIKE strCriteriaParam OR OEM2 LIKE strCriteriaParam OR OEM3 LIKE strCriteriaParam 
OR OEM4 LIKE strCriteriaParam OR OEM5 LIKE strCriteriaParam OR OEM6 LIKE strCriteriaParam 
OR OEM7 LIKE strCriteriaParam OR OEM8 LIKE strCriteriaParam OR OEM9 LIKE strCriteriaParam 
OR OEM10 LIKE strCriteriaParam OR OEM11 LIKE strCriteriaParam OR OEM12 LIKE strCriteriaParam 
OR OEM13 LIKE strCriteriaParam OR OEM14 LIKE strCriteriaParam OR OEM15 LIKE strCriteriaParam 
OR OEM16 LIKE strCriteriaParam OR OEM17 LIKE strCriteriaParam OR OEM18 LIKE strCriteriaParam 
OR OEM19 LIKE strCriteriaParam OR OEM20 LIKE strCriteriaParam OR OEM21 LIKE strCriteriaParam 
OR OEM22 LIKE strCriteriaParam OR OEM23 Like strCriteriaParam OR OEM24 LIKE strCriteriaParam 
OR OEM25 LIKE strCriteriaParam OR OEM26 LIKE strCriteriaParam OR OEM27 LIKE strCriteriaParam 
OR OEM28 LIKE strCriteriaParam OR OEM29 LIKE strCriteriaParam OR OEM30 LIKE strCriteriaParam 
OR OEM31 LIKE strCriteriaParam OR OEM32 LIKE strCriteriaParam OR OEM33 LIKE strCriteriaParam 
OR OEM34 LIKE strCriteriaParam OR OEM35 LIKE strCriteriaParam OR OEM36 LIKE strCriteriaParam 
OR OEM37 LIKE strCriteriaParam OR OEM38 LIKE strCriteriaParam OR OEM39 LIKE strCriteriaParam 
OR OEM40 LIKE strCriteriaParam OR OEM41 LIKE strCriteriaParam OR OEM42 LIKE strCriteriaParam 
OR OEM43 LIKE strCriteriaParam OR OEM44 LIKE strCriteriaParam OR OEM45 LIKE strCriteriaParam 
OR OEM46 LIKE strCriteriaParam OR OEM47 LIKE strCriteriaParam OR OEM48 LIKE strCriteriaParam 
OR OEM49 LIKE strCriteriaParam OR OEM50 LIKE strCriteriaParam OR OEM51 LIKE strCriteriaParam 
OR OEM52 LIKE strCriteriaParam OR OEM53 LIKE strCriteriaParam OR OEM54 LIKE strCriteriaParam 
OR OEM55 LIKE strCriteriaParam OR OEM56 LIKE strCriteriaParam OR OEM57 LIKE strCriteriaParam 
OR OEM58 LIKE strCriteriaParam OR OEM59 LIKE strCriteriaParam OR OEM60 LIKE strCriteriaParam 
OR OEM61 LIKE strCriteriaParam OR OEM62 LIKE strCriteriaParam OR OEM63 LIKE strCriteriaParam 
OR OEM64 LIKE strCriteriaParam OR OEM65 LIKE strCriteriaParam OR OEM66 LIKE strCriteriaParam 
OR OEM67 LIKE strCriteriaParam OR OEM68 LIKE strCriteriaParam OR OEM69 LIKE strCriteriaParam 
OR OEM70 LIKE strCriteriaParam OR OEM71 LIKE strCriteriaParam OR OEM72 LIKE strCriteriaParam 
OR OEM73 LIKE strCriteriaParam OR OEM74 LIKE strCriteriaParam OR OEM75 LIKE strCriteriaParam

VBA （使用MainSearch文本框的AfterUpdate事件） 

Private Sub MainSearch_AfterUpdate()    
    Dim qDef As QueryDef
    Dim rst As Recordset

    Set qDef = CurrentDb.QueryDefs("mySavedQuery")

    ' BIND PARAMETER TO VBA VALUE
    qDef!strCriteriaParam = "*" & Me.MainSearch.Text & "*"

    ' OPEN QUERYDEF'S UNDERLYING RECORDSET
    Set rst = qDef.OpenRecordset()

    ' UPDATE FORM RECORDSET BY QUERY OUTPUT
    Set Me.Form.Recordset = rst

    Set rst = Nothing
    Set qDef = Nothing
End Sub

除此之外 - 如上所述，如果您能够这样做，请考虑调整表架构并避免使用非常宽的表格，这些表格可以说更具可维护性，可扩展性和高效性。

相关问题
最新问题