如何使用 Excel VBA 输入参数来限制使用 ADODB.connection 和 ADODB.Recordset 的查询结果？

Question

从 Stack Overflow 用户和 Christos Samaras 的使用 VBA 从 Excel 运行 Access 查询中，我获得了使用参数从 Access 获取数据所需的大部分内容。

'''此代码有效'''

Public Function ProjLookup(ProjID As String) As Boolean

Dim INV_WB As Workbook
Dim ProjSet As Worksheet
Dim CovPage As Worksheet
Dim DataConnect As Object
Dim RecordSet As Object
Dim strTable As String
Dim strSQL As String
Dim i As Integer

Set INV_WB = ActiveWorkbook
Set ProjSet = INV_WB.Worksheets("ProjectSetup")
Set CovPage = INV_WB.Worksheets("CoverPage")

'---> Establish connection
On Error Resume Next
Set DataConnect = CreateObject("ADODB.connection")
If Err.Number <> 0 Then
    MsgBox "Connection was not created", vbCritical, "Connection Error"
    Exit Function
End If
On Error GoTo 0

'---> Open connection with Project Details database
DataConnect.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Users\CTR90947\OneDrive - PAE\Database\Project Details.accdb"


'---->I would like to enter 601130 into an InputBox                        
strSQL = "SELECT [Level_1_ProjID], [Legacy_Lvl1_Proj], [ProjectID], [Legacy_ProjID], [Level_Number], [Project_Name] FROM qr_Map_ProjSetupDetail WHERE [Level_1_ProjID] = '601130'"
    
'Create Recordset    
Set RecordSet = CreateObject("ADODB.Recordset")

If Err.Number <> 0 Then
    Set RecordSet = Nothing
    Set DataConnect = Nothing
    MsgBox "Recordset was not created", vbCritical, "Recordset Error"
End If

RecordSet.CursorLocation = 3
RecordSet.CursorType = 1

'Open Recordset using strSQL
RecordSet.Open strSQL, DataConnect

If RecordSet.EOF And RecordSet.BOF Then
    RecordSet.Close
    DataConnect.Close
    
    Set RecordSet = Nothing
    Set DataConnect = Nothing
    
    MsgBox "There are no records in the recordset", vbCritical, "No Records Found"
    
    Exit Function
End If

'---> Enter names into columns in ProjectSetup worksheet
For i = 0 To RecordSet.Fields.Count - 1
    ProjSet.Cells(5, i + 1) = RecordSet.Fields(i).Name
Next i

'---> Populate ProjectSetup worksheet using recordset results
ProjSet.Range("A6").CopyFromRecordset RecordSet

RecordSet.Close
DataConnect.Close

MsgBox "Project Setup Query complete!"

End Function

我想使用输入框输入参数。它告诉我记录集尚未创建。然后函数退出，什么也没有发生。

我尝试了设置 strSQL 字符串的不同版本。

'''此代码不起作用'''

Public Function ProjLookupWithInputBox(ProjID As String) As Boolean

Dim INV_WB As Workbook
Dim ProjSet As Worksheet
Dim CovPage As Worksheet
Dim LVL1_GLPROD_ID As String
Dim DataConnect As Object
Dim RecordSet As Object
Dim strTable As String
Dim strSQL As String
Dim i As Integer

Set INV_WB = ActiveWorkbook
Set ProjSet = INV_WB.Worksheets("ProjectSetup")
Set CovPage = INV_WB.Worksheets("CoverPage")

On Error Resume Next
Set DataConnect = CreateObject("ADODB.connection")
If Err.Number <> 0 Then
    MsgBox "Connection was not created", vbCritical, "Connection Error"
    Exit Function
End If
On Error GoTo 0

DataConnect.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=C:\Users\CTR90947\OneDrive - PAE\Database\Project Details.accdb"
                    
LVL1_GLPROD_ID = InputBox(Prompt:="Enter 6 Digit GLPRD Project ID", Title:="Project ID Input Box", Default:="Type Here")
strSQL = "SELECT [Level_1_ProjID], [Legacy_Lvl1_Proj], [ProjectID], [Legacy_ProjID], [Level_Number], [Project_Name] FROM qr_Map_ProjSetupDetail WHERE [Level_1_ProjID] = 'LVL1_GLPROD_ID'"
    
Set RecordSet = CreateObject("ADODB.Recordset")

If Err.Number <> 0 Then
    Set RecordSet = Nothing
    Set DataConnect = Nothing
    MsgBox "Recordset was not created", vbCritical, "Recordset Error"
End If

RecordSet.CursorLocation = 3
RecordSet.CursorType = 1

RecordSet.Open strSQL, DataConnect

If RecordSet.EOF And RecordSet.BOF Then
    RecordSet.Close
    DataConnect.Close
    
    Set RecordSet = Nothing
    Set DataConnect = Nothing
    
    MsgBox "There are no records in the recordset", vbCritical, "No Records Found"
    
    Exit Function
End If

For i = 0 To RecordSet.Fields.Count - 1
    ProjSet.Cells(5, i + 1) = RecordSet.Fields(i).Name
Next i

ProjSet.Range("A6").CopyFromRecordset RecordSet

RecordSet.Close
DataConnect.Close

MsgBox "Project Setup Query complete!"

End Function

当我单步执行代码并通过本地屏幕查看进度时，一切似乎都正常，直到

RecordSet.Open strSQL, DataConnect

。没有返回任何记录。

Answer 1

不起作用的代码在字符串文字中包含变量 - 不能以这种方式引用变量。必须是

     LVL1_GLPROD_ID = InputBox(Prompt:="Enter 6 Digit GLPRD Project ID", Title:="Project ID Input Box", Default:="Type Here")
     strSQL = "SELECT [Level_1_ProjID], [Legacy_Lvl1_Proj], [ProjectID], [Legacy_ProjID], [Level_Number], [Project_Name] FROM qr_Map_ProjSetupDetail WHERE [Level_1_ProjID] = '" & LVL1_GLPROD_ID & "'"

更多技术废话：

它不起作用的真正原因是“[Level_1_ProjID]”列中没有等于“LVL1_GLPROD_ID”的值

我还为你做了一些简单的重写：

Public Function ProjLookupWithInputBox(ProjID As String) As Boolean
    Dim INV_WB As Workbook
    Dim LVL1_GLPROD_ID As String, strTable As String, strSQL As String
    Dim DataConnect As Object, rs As Object     'also naming objects after reserved words is dumb.
    Dim i As long   'i dont use integer often, because sometimes you unintentionally get past the upperbound of the data type. Plus int in SQL Server = long in vba

    Set INV_WB = ActiveWorkbook
    On Error Resume Next    'i hate this
    Set DataConnect = CreateObject("ADODB.connection")
    If Err.Number <> 0 Then
        MsgBox "Connection was not created", vbCritical, "Connection Error"
        Exit Function
    End If
    On Error GoTo 0         ' i also hate this

    DataConnect.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\Users\CTR90947\OneDrive - PAE\Database\Project Details.accdb"
    LVL1_GLPROD_ID = InputBox(Prompt:="Enter 6 Digit GLPRD Project ID", Title:="Project ID Input Box", Default:="Type Here")
    strSQL = "SELECT [Level_1_ProjID], [Legacy_Lvl1_Proj], [ProjectID], [Legacy_ProjID], [Level_Number], [Project_Name] FROM qr_Map_ProjSetupDetail WHERE [Level_1_ProjID] ='" & LVL1_GLPROD_ID & "';"

    Set rs = CreateObject("ADODB.Recordset")
    If Err.Number <> 0 Then
        Set rs = Nothing
        Set DataConnect = Nothing
        MsgBox "rs was not created", vbCritical, "rs Error"
    End If

    rs.CursorLocation = 3
    rs.CursorType = 1
    rs.Open strSQL, DataConnect

    If rs.EOF And rs.BOF Then
        rs.Close
        DataConnect.Close
        Set rs = Nothing
        Set DataConnect = Nothing
        MsgBox "There are no records in the recordset", vbCritical, "No Records Found"
        Exit Function
    End If

    For i = 0 To rs.Fields.Count - 1
        INV_WB.Worksheets("ProjectSetup").Cells(5, i + 1) = rs.Fields(i).Name
    Next i

    INV_WB.Worksheets("ProjectSetup").Range("A6").CopyFromRecordSet rs
    rs.Close
    DataConnect.Close
    MsgBox "Project Setup Query complete!"
End Function