使用Excel VBA，如何使用ADODB.connection和ADODB.Recordset限制查詢的結果？

Question

經過一段時間和來自stackOverflow用戶的大量幫助以及有關[使用VBA在Excel中運行訪問查詢]的Christos Samaras教程（ https://myengineeringworld.net/2013/10/running-access-queries-from-excel-vba.html ），就可以使用參數從Access獲取數據而言，我已滿足了大部分需求。

這是我的問題，我想使用InputBox輸入參數。 由於某種原因，它一直告訴我未創建記錄集。 然后函數退出，什么也沒有發生。

我嘗試使用不同版本的設置strSQL字符串，但是每次我都進一步遠離它的時候。

同樣，第一個代碼確實可以工作，但是我很難實現一些需要參數的東西。

'''此代碼有效'''

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

'''此代碼無效'''

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

當我遍歷代碼並在Locals屏幕上查看進度時，一切似乎都正常，直到我逐步執行“ 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