LinkBack URL
About LinkBacks
Here's what I'm trying to accomplish with the code below: I want excel to query my access database (the query works, as I've tested it in access, and I have a debug line that shows I have return values), then loop through the query results and populate cells in my ActiveSheet with those values. The code runs off an ActiveX Command button (CommandButton1), which is on the sheet containing the cells in question, so when the button is clicked, the ActiveSheet should always be the sheet I want this code to work with. The loop that should take care of the populating the cells is in red - when I run this code, the cells do not populate:
Private Sub CommandButton1_Click()
Dim sSQL As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim row As Integer
Dim col As Integer
Dim test As Integer
Dim startDate As Date
Dim endDate As Date
startDate = CDate(InputBox("Please enter a start date (##/##/####):", "Start Date", TODAY))
endDate = CDate(InputBox("Please enter an end date (##/##/####):", "End Date", TODAY))
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=I:\User Files\AdministrativeSupervisor\" & _
"HS DC Documents\Quality-Risk Mgmt\Databases\" & _
"Physician Auditing\Quality_Test.accdb"
sSQL = "SELECT Left(Doctor.Last_Name, 1) & Left(Doctor.First_Name, 1), MRR.[Med_Rec#], " & _
"MRR.MRR001, MRR.MRR002, MRR.MRR003, MRR.MRR004, MRR.MRR005, " & _
"[MDMRR1-2].MDMRR001, [MDMRR1-2].MDMRR002, [MDMRR3-4].MDMRR003, " & _
"[MDMRR3-4].MDMRR004, MRR.MRR006, MRR.MRR007, MRR.MRR008, " & _
"MRR.MRR009, MRR.MRR010, MRR.MRR011, MRR.MRR012, MRR.MRR013, " & _
"MRR.MRR014, MDMRR5.MDMRR005, MDMRR6.MDMRR006, MDMRR7.MDMRR007, " & _
"MDMRR8.MDMRR008, MRR.MRR015, MRR.MRR016, MRR.MRR017, MRR.MRR018, " & _
"MRR.MRR019, MRR.MRR020, MRR.MRR021, MRR.MRR022, MRR.MRR023, " & _
"MRR.MRR024, MRR.MRR025, MRR.MRR026, MRR.MRR027, MRR.MRR028, " & _
"MRR.MRR029, MRR.MRR030, MRR.MRR031, MRR.MRR032, MDMRR9.MDMRR009, " & _
"MDMRR10.MDMRR010, MRR.MRR033, MRR.MRR034, MRR.MRR035, MRR.MRR036, " & _
"MRR.MRR037, MRR.MRR038, MRR.MRR039, MRR.MRR040, MRR.MRR041, MRR.MRR042 " & _
"FROM (((((((((Doctor INNER JOIN MRR ON Doctor.Doctor_ID=" & _
"MRR.Attending) LEFT JOIN MDMRR10 ON MRR.MRR_ID=MDMRR10.MRR_ID) " & _
"LEFT JOIN [MDMRR1-2] ON MRR.MRR_ID=[MDMRR1-2].MRR_ID) LEFT JOIN " & _
"[MDMRR3-4] ON MRR.MRR_ID=[MDMRR3-4].MRR_ID) LEFT JOIN MDMRR5 ON " & _
"MRR.MRR_ID=MDMRR5.MRR_ID) LEFT JOIN MDMRR6 ON MRR.MRR_ID=" & _
"MDMRR6.MRR_ID) LEFT JOIN MDMRR7 ON MRR.MRR_ID=MDMRR7.MRR_ID) " & _
"LEFT JOIN MDMRR8 ON MRR.MRR_ID=MDMRR8.MRR_ID) LEFT JOIN MDMRR9 ON " & _
"MRR.MRR_ID=MDMRR9.MRR_ID) " & _
"WHERE ((MRR.Date_Reviewed) Between " & startDate & _
" And " & endDate & ");"
Set rs = New ADODB.Recordset
rs.Open sSQL, cn
test = MsgBox(rs.Fields.Count, vbOKOnly, "Debug") 'Debug to see if query worked
If Not (rs.BOF Or rs.EOF) Then 'If there are no records, this will be false
rs.MoveFirst
End If
col = 2
Do While Not rs.EOF 'Start looping through the records
For row = 0 To rs.Fields.Count - 1
ActiveSheet.Cells(row + 1, col).Value = rs.Fields(row).Value
Next row
rs.MoveNext
col = col + 1
Loop
'Close recordset and connection
rs.Close
cn.Close
'Clean up
Set rs = Nothing
Set cn = Nothing
End Sub
By the way, the column offset (col = 2) is on purpose. Also, my loop should be placing each field in a new row of the same column and each record will get a new column - this too is on purpose.
Any help to this hopelessly clueless noob is greatly appreciated (this my first time working with Excel VBA)!
Register To Reply
Bookmarks