使用Excel VBA时，如何使用ADODB.connection和ADODB.Recordset限制查询结果？

Question

在stackOverflow用户和Running Access Queries From Excel Using VBA上的Christos Samaras教程提供了一些时间和大量帮助后，我获得了使用参数从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

当我遍历代码并通过本地变量屏幕查看进度时，一切似乎都很正常，直到我单步执行“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