使用 Excel VBA，如何限制使用 ADODB.connection & ADODB.Recordset 的查询结果？
Using Excel VBA, How do I limit the results of a query using ADODB.connection & ADODB.Recordset?
在 Whosebug 用户和 Christos Samaras Tutorial on [运行 Access Queries From Excel Using VBA] (https://myengineeringworld.net/2013/10/running-access-queries-from-excel-vba.html) 的一些时间和大量帮助之后，我获得了我使用参数从 Access 获取数据所需的大部分内容。
这是我的问题，我想使用 InputBox 输入参数。出于某种原因，它一直告诉我没有创建记录集。然后函数退出，什么也没有发生。
我曾尝试使用不同版本的 strSQL 字符串设置，但每次我都离它更远。
同样，第一个代码确实有效，但我很难实现需要参数的东西。
'''THIS CODE WORKS'''
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' 行。不确定为什么没有返回任何记录。
不起作用的代码在字符串文字中包含变量 - 不能以这种方式引用变量。必须是
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
在 Whosebug 用户和 Christos Samaras Tutorial on [运行 Access Queries From Excel Using VBA] (https://myengineeringworld.net/2013/10/running-access-queries-from-excel-vba.html) 的一些时间和大量帮助之后，我获得了我使用参数从 Access 获取数据所需的大部分内容。
这是我的问题，我想使用 InputBox 输入参数。出于某种原因，它一直告诉我没有创建记录集。然后函数退出，什么也没有发生。
我曾尝试使用不同版本的 strSQL 字符串设置，但每次我都离它更远。
同样，第一个代码确实有效，但我很难实现需要参数的东西。
'''THIS CODE WORKS'''
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' 行。不确定为什么没有返回任何记录。
不起作用的代码在字符串文字中包含变量 - 不能以这种方式引用变量。必须是
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