From Stack Overflow users and Christos Samaras' Running Access Queries From Excel Using VBA, I got most of what I need to get data from Access using a parameter.
'''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
I would like to enter the parameter using an InputBox. It tells me the recordset was not created. Then the function exits and nothing has happened.
I tried different versions of setting up the strSQL string.
'''THIS CODE DOESN'T WORK'''
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
When I step through the code and watch the progress through the Locals screen, everything seems to work until RecordSet.Open strSQL, DataConnect. No records are returned.
the code that doesnt work has the variable within the string literal - the variable cannot be referenced this way. It has to be
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 & "'"
More technical nonsense:
the real reason it doesnt work is there is no value in the column "[Level_1_ProjID]" that equals "LVL1_GLPROD_ID"
i also did some light rewrite for you:
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