I'm trying to use Excel as a Database, and I'm following a tutorial from this site.
Problem is, whenever I try to "Update Drop Downs" in the file below, I get this error: "Microsoft is waiting for another application to complete an OEL action".
What am I missing or doing wrong here, and how do I get this right?
I'm using Excel 2016 Home & Student that's uptodate. I also enable Macros when opening the Workbook.
The same file runs perfect when open in Excel 2007. I've also noticed that Microsoft ActiveX Data Objects 6.0 Library references a "msado60.dll" in the example, whereas, it's a "msado60.tlb" file in Excel 2016 (which I use).
Link to Excel File
Private Sub cmdShowData_Click()
'populate data
strSQL = "SELECT * FROM [data$] WHERE "
If cmbProducts.Text <> "" Then
strSQL = strSQL & " [Product]='" & cmbProducts.Text & "'"
End If
If cmbRegion.Text <> "" Then
If cmbProducts.Text <> "" Then
strSQL = strSQL & " AND [Region]='" & cmbRegion.Text & "'"
Else
strSQL = strSQL & " [Region]='" & cmbRegion.Text & "'"
End If
End If
If cmbCustomerType.Text <> "" Then
If cmbProducts.Text <> "" Or cmbRegion.Text <> "" Then
strSQL = strSQL & " AND [Customer Type]='" & cmbCustomerType.Text & "'"
Else
strSQL = strSQL & " [Customer Type]='" & cmbCustomerType.Text & "'"
End If
End If
If cmbProducts.Text <> "" Or cmbRegion.Text <> "" Or cmbCustomerType.Text <> "" Then
'now extract data
closeRS
OpenDB
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Sheets("View").Visible = True
Sheets("View").Select
Range("dataSet").Select
Range(Selection, Selection.End(xlDown)).ClearContents
'Now putting the data on the sheet
ActiveCell.CopyFromRecordset rs
Else
MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
Exit Sub
End If
'Now getting the totals using Query
If cmbProducts.Text <> "" And cmbRegion.Text <> "" And cmbCustomerType.Text <> "" Then
strSQL = "SELECT Count([data$].[Call ID]) AS [CountOfCall ID], [data$].[Resolved] " & _
" FROM [Data$] WHERE ((([Data$].[Product]) = '" & cmbProducts.Text & "' ) And " & _
" (([Data$].[Region]) = '" & cmbRegion.Text & "' ) And (([Data$].[Customer Type]) = '" & cmbCustomerType.Text & "' )) " & _
" GROUP BY [data$].[Resolved];"
closeRS
OpenDB
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Range("L6").CopyFromRecordset rs
Else
Range("L6:M7").Clear
MsgBox "There was some issue getting the totals.", vbExclamation + vbOKOnly
Exit Sub
End If
End If
End If
End Sub
Private Sub cmdUpdateDropDowns_Click()
strSQL = "Select Distinct [Product] From [data$] Order by [Product]"
closeRS
OpenDB
cmbProducts.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
cmbProducts.AddItem rs.Fields(0)
rs.MoveNext
Loop
Else
MsgBox "I was not able to find any unique Products.", vbCritical + vbOKOnly
Exit Sub
End If
'----------------------------
strSQL = "Select Distinct [Region] From [data$] Order by [Region]"
closeRS
OpenDB
cmbRegion.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
cmbRegion.AddItem rs.Fields(0)
rs.MoveNext
Loop
Else
MsgBox "I was not able to find any unique Region(s).", vbCritical + vbOKOnly
Exit Sub
End If
'----------------------
strSQL = "Select Distinct [Customer Type] From [data$] Order by [Customer Type]"
closeRS
OpenDB
cmbCustomerType.Clear
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
Do While Not rs.EOF
cmbCustomerType.AddItem rs.Fields(0)
rs.MoveNext
Loop
Else
MsgBox "I was not able to find any unique Customer Type(s).", vbCritical + vbOKOnly
Exit Sub
End If
End Sub
Per the comments, your OpenDB
method is opening an ADO connection. You don't appear to be closing it anywhere.
You're attempting to reopen a connection that is already open. The OLE server error is telling you that the server (Excel) is busy because there is already another ADO connection attached to it. All you should need to do is make sure that you only open the connection once, and then close it when you are done working with it.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With