Use Excel as Database by opening excel workbook as ADODB object

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.

Originally Posted by JosephP

you should be able to use INSERT INTO queries to append data or SELECT INTO to create new sheets http://support.microsoft.com/kb/295646

Hi,

thanks for your response!

I tried the post you have given me and it still didn't work...

Here's the code:

Public Function DBSource() As String
    DBSource = "'' [Excel 8.0;Database=" & _
    ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name & "]"
End Function

Private Sub insertRow()
    Dim strSQL As String
    Dim DBSource As String
    
    OpenDB
    
    strSQL = "INSERT INTO [data$] in " & DBSource & " Values ('CL14833', '2/20/2012 22:00:12', 'Accessories', 'West', " _
            & "'SME', 73, 'Yes', 2.6, 270, 'Agent Neo'"
    
    cnn.Execute strSQL
    
End Sub

Can't you install SQL Server Express? It's free