Hi,
I have seen very limited help online on this because most people are trying to use other sources as either front end or back end, such as Access, SQL server or .NET etc. But in this case my database sits in a in-house analysis application in Excel, I have no support in any corporate database nor do I have Access application in my standard XP installation. So I need to use Excel as a database to store data.
I have created a connection that queries tables fine, so that part worked well. Here's the code
Option Explicit
Public cnn As ADODB.Connection
Public rs As ADODB.Recordset
Public strSQL As String
Public Sub OpenDB()
Set cnn = New ADODB.Connection
If cnn.State = adStateOpen Then cnn.Close
cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
cnn.Open
End Sub
Public Sub closeRS()
Set rs = New ADODB.Recordset
If rs.State = adStateOpen Then rs.Close
rs.CursorLocation = adUseClient
End Sub
Private Sub cmdShowData_Click()
strSQL = "SELECT * FROM [data$], [test$] WHERE [data$].[Call ID]=[test$].[Call ID] AND "
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
End If
End Sub
This part was working fine.
However the problem is I need it to have other basic function of a datbase, such as adding, editing and deleting tables.
But here's where the probelm lies, it doesn't work no matter what form of SQL or code combinations I tried. It always gives me an run time error '-2147217887' (8004e21) <- some random long strings that are different every single time.
The code is as below:
v1:
Private Sub insertRow()
Dim strSQL As String
OpenDB
Set rs = New ADODB.Recordset
strSQL = "[data$]"
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTable
rs.AddNew
rs![Call ID] = "CL12833"
rs![Product] = "Accessories"
rs.Update
blnRecordAdded = True
End Sub
This one didnt work.
v2:
Private Sub insertRow()
Dim strSQL As String
OpenDB
Set rs = New ADODB.Recordset
strSQL = "[data$]"
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTable
rs.AddNew
Dim fieldsArray(9) As Variant
fieldsArray(0) = "Call ID"
fieldsArray(1) = "Date Time"
fieldsArray(2) = "Product"
fieldsArray(3) = "Region"
fieldsArray(4) = "Customer Type"
fieldsArray(5) = "Call Duration"
fieldsArray(6) = "Resolved"
fieldsArray(7) = "Satisfaction Ratio"
fieldsArray(8) = "Up-sell"
fieldsArray(9) = "Agent ID"
Dim values(9) As Variant
values(0) = "CL14833"
values(1) = "2/20/2012 22:00:12"
values(2) = "Accessories"
values(3) = "West"
values(4) = "SME "
values(5) = 73
values(6) = "Yes"
values(7) = 2.6
values(8) = 270
values(9) = "Agent Neo"
rs.AddNew fieldsArray, values
rs.Update
End Sub
This one didnt work either.
Bookmarks