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

Question

在 stackOverflow 用户和 Christos Samaras 关于 [使用 VBA 从 Excel 运行访问查询] 教程 (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