VBA-SQL UPDATE/INSERT/SELECT to/from Excel worksheet

Question

In a nutshell: I'm making a scheduler for my client and, due to constraints, it needs to be in a single excel file (as small as possible). So one worksheet works as the UI and any others will be tables or settings.

I'm trying to use SQL (to which I'm new) to work with the schedule data on a single worksheet (named "TblEmpDays"). So I need to add/update and retrieve records to/from this worksheet. I was able to get a SELECT query to work with some arbitrary data (and paste to a Range). However, I'm not able to get INSERT or UPDATE to work. I've seen it structured as INSERT INTO [<table name>$] (<field names>) VALUES (<data>);. However this gives me a run-time error "'-2147217900 (80040e14)' Syntax error in INSERT INTO statement."

I'm using VBA to write all of this and I made an SQL helper class to make the query execution easier.

To clarify, my question is: How do I need to construct the INSERT and UPDATE queries? What am I missing? I'm trying to post as much related info as possible, so let me know if I missed anything.

Class SQL:

Private pCn ' As Database
Private pResult 'As Recordset
Private pSqlStr As String

Public Property Get Result()
    Result = pResult
End Property

Public Function Init()
    Set pCn = CreateObject("ADODB.Connection")

    With pCn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                            "Data Source=" & ThisWorkbook.FullName & ";" & _
                            "Extended Properties=""Excel 12.0 Macro;HDR=YES;ReadOnly=False"";"
        .Open
    End With

End Function

Public Function Cleanup()
    If Not (pCn Is Nothing) Then
        pCn.Close
        Set pCn = Nothing
    End If

    If Not pResult Is Nothing Then
        Set pResult = Nothing
    End If

End Function

Public Function CopyResultToRange(rg As Range)
    If Not rg Is Nothing And Not pResult Is Nothing Then
        rg.CopyFromRecordset pResult
    End If
End Function

Public Property Get query() As String
    query = pSqlStr
End Property
Public Property Let query(value As String)
    pSqlStr = value
End Property

Public Function Execute(Optional sqlQuery As String)
    If sqlQuery = "" Then
        sqlQuery = query
    End If

    If Not pCn Is Nothing Then
        Set pResult = pCn.Execute(sqlQuery, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
    Else
        MsgBox "SQL connection not established"
    End If

End Function

Executing function:

Dim s As SQL ' this is the SQL class '
Dim tbl As String
' rcDay=date string, rcIn & rcOut = time strings, rcVac=boolean string, rcSls=number string'
Dim rcName As String, rcDay As String, rcIn As String, rcOut As String, rcVac As String, rcSls As String
Dim qry As String

tbl = "[TblEmpDays$]"
qry = "INSERT INTO <tbl> (name, date, in, out, vac, sales)" & vbNewLine & _
        "VALUES ('<name>', '<date>', '<in>', '<out>', '<vac>', <sales>);"

' Set rc* vars '

s.Init
s.query = Replace(Replace(Replace(Replace(Replace(Replace(Replace(qry, _
                                    "<tbl>", tbl), _
                                    "<sales>", rcSls), _
                                    "<vac>", rcVac), _
                                    "<out>", rcOut), _
                                    "<in>", rcIn), _
                                    "<date>", rcDay), _
                                    "<name>", rcName)
MsgBox s.query
s.Execute
s.Cleanup

I've looked all over an can't find a solution. I'm sure I just haven't searched the right phrase or something simple.

Answer 1

I'm posting the solution here since I can't mark his comment as the answer.

---

Thanks to @Jeeped in the comments, I now feel like an idiot. It turns out three of my field names were using reserved words ("name", "date", and "in"). It always seems to be a subtle detail that does me in...

I renamed these fields in my worksheet (table) and altered the appropriate code. I also had to Cast the input strings into the proper data types. I'm still working the rest of the details out, but here's the new query:

qry = "INSERT INTO <tbl> (empName, empDay, inTime, outTime, vac, sales)" & vbNewLine & _
                  "VALUES (CStr('<name>'), CDate('<date>'), CDate('<in>'), CDate('<out>'), " & _
                      "CBool('<vac>'), CDbl(<sales>));"

I needed the CDate() (instead of the #*#) so I could pass in a string. So CDate('<date>') instead of #<date>#

Answer 2

Consider using a relational database as backend instead of a worksheet for your project. You can continue to use the UI spreadsheet as a frontend. As a Windows product, the Jet/ACE SQL Engine can be a working solution plus it allows multiple user with simultaneous access (with record-level locking). Additionally, Jet/ACE comes equipped with its own SQL dialect for Database Definition Language (DDL) and Database Maniupulation Language (DML) procedures. And Excel can connect to Jet/ACE via ADO/DAO objects. The only difference of Jet/ACE compared to other RDMS is that it is a file level database (not server) and you cannot create a database using SQL. You must first create the database file using VBA or other COM defined language.

Below are working examples of VBA scripts (Clients and Orders tables) in creating a database with DAO, creating tables with ADO, executing action queries, and copying a recordset to worksheet. Integrate these macros into your project. Use error handling and debug.Print to help develop your app. If you do not have MS Access installed, the .accdb file will show in directory but with blank icon. There will be no user interface to manage the file except via code.

Sub CreateDatabase()
On Error GoTo ErrHandle
    Dim fso As Object
    Dim olDb As Object, db As Object
    Dim strpath As String
    Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"

    strpath = "C:\Path\To\Database\File.accdb"

    ' CREATE DATABASE '
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set olDb = CreateObject("DAO.DBEngine.120")

    If Not fso.FileExists(strpath) Then
        Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
    End If

    Set db = Nothing
    Set olDb = Nothing
    Set fso = Nothing

    MsgBox "Successfully created database!", vbInformation
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Exit Sub
End Sub

Sub CreateTables()
On Error GoTo ErrHandle
    Dim strpath As String, constr As String
    Dim objAccess As Object
    Dim conn As Object

    strpath = "C:\Path\To\Database\File.accdb"

    ' CONNECT TO DATABASE '
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
    Set conn = CreateObject("ADODB.Connection")
    conn.Open constr

    ' CREATE TABLES (RUN ONLY ONCE) '
    conn.Execute "CREATE TABLE Clients (" _
                    & " ClientID AUTOINCREMENT," _
                    & " ClientName TEXT(255)," _
                    & " Address TEXT(255)," _
                    & " Notes TEXT(255)," _
                    & " DateCreated DATETIME" _
                    & ");"

    conn.Execute "CREATE TABLE Orders (" _
                    & " OrderID AUTOINCREMENT," _
                    & " ClientID INTEGER," _
                    & " Item TEXT(255)," _
                    & " Price DOUBLE," _
                    & " OrderDate DATETIME," _
                    & " Notes TEXT(255)" _
                    & ");"

    ' CLOSE CONNECTION '
    conn.Close
    Set conn = Nothing

    MsgBox "Successfully created Clients and Orders tables!", vbInformation
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Exit Sub

End Sub

Sub RetrieveDataToWorksheet()
On Error GoTo ErrHandle
    Dim strpath As String, constr As String
    Dim conn As Object, rs As Object
    Dim fld As Variant

    strpath = "C:\Path\To\Database\File.accdb"

    ' OPEN CONNECTION '
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    conn.Open constr
    rs.Open "SELECT * FROM Clients" _
             & " INNER JOIN Orders ON Clients.ClientID = Orders.ClientID;", conn

    ' COPY FROM RECORDSET TO WORKSHEET '
    Worksheets(1).Activate
    Worksheets(1).Range("A4").Select

    ' COLUMN NAMES '
    For Each fld In rs.Fields
        ActiveCell = fld.Name
        ActiveCell.Offset(0, 1).Select
    Next

    ' ROW VALUES '
    Worksheets(1).Range("A5").CopyFromRecordset rs

    ' CLOSE RECORDSET AND CONNECTION '
    rs.Close
    conn.Close

    Set conn = Nothing
    Set rs = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Exit Sub
End Sub

Sub ActionQueries()
On Error GoTo ErrHandle
    Dim strpath As String, constr As String
    Dim conn As Object

    strpath = "C:\Path\To\Database\File.accdb"

    ' OPEN CONNECTION '
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
    Set conn = CreateObject("ADODB.Connection")
    conn.Open constr

    ' APPEND QUERY '
    conn.Execute "INSERT INTO Clients (ClientID, ClientName)" _
                    & " VALUES (" & Worksheets(1).Range("A2") & ", '" & Worksheets(1).Range("B2") & "');"

    conn.Execute "INSERT INTO Orders (ClientID, Item, Price)" _
                    & " VALUES (" & Worksheets(1).Range("A2") & ", " _
                    & "'" & Worksheets(1).Range("C2") & "', " _
                    & Worksheets(1).Range("D2") & ");"

    ' UPDATE QUERY '
    conn.Execute "UPDATE Clients " _
                    & " SET Address = '" & Worksheets(1).Range("E2") & "'" _
                    & " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"

    ' DELETE QUERY '
    conn.Execute "DELETE FROM Orders " _
                    & " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"

    ' CLOSE CONNECTION '
    conn.Close
    Set conn = Nothing

    MsgBox "Successfully updated database!", vbInformation
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
    Exit Sub
End Sub