Generate SQL using Excel VBA

modSQL.bas

'---------------------------------------------------------------------------------------
' Module    : modSQL
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/1/2015
' Purpose   : generate SQL queries from Excel cell data
'---------------------------------------------------------------------------------------

Option Explicit

Enum eEscape
    eNONE = 0
    eMSSQL = 1
    eMYSQL = 2
End Enum

'---------------------------------------------------------------------------------------
' Procedure : SqlUpdate
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/2/2015
' Purpose   : create an UPDATE statement using
'             a set of fields and
'             a set of values and
'             optional criteria
'---------------------------------------------------------------------------------------
'
Public Function SqlUpdate(ByVal Table As String, ByVal Fields As Range, ByVal Values As Range, Optional ByVal Criteria As String = "", Optional Escape As eEscape = eNONE) As String
    Dim sql As String

    If Fields.Count <> Values.Count Then
        Err.Raise vbObjectError + 1, "modSQL", "Fields and Values do not match in size"
    End If
    sql = "UPDATE @table SET @assignments WHERE @criteria;"
    sql = Replace(sql, "@table", Table)
    sql = Replace(sql, "@assignments", SqlCombinePairs(Fields, Values, Escape))
    sql = Replace(sql, "@criteria", Criteria)
    sql = Replace(sql, " WHERE ;", ";")
    SqlUpdate = sql
End Function

'---------------------------------------------------------------------------------------
' Procedure : SqlInsert
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/2/2015
' Purpose   : create an INSERT statement using a set of fields and a set of values
'---------------------------------------------------------------------------------------
'
Public Function SqlInsert(ByVal Table As String, ByVal Fields As Range, ByVal Values As Range, Optional Escape As eEscape = eNONE) As String
    Dim sql As String

    If Fields.Count <> Values.Count Then
        Err.Raise vbObjectError + 1, "modSQL", "Fields and Values do not match in size"
    End If
    sql = "INSERT INTO @table (@fields) VALUES (@values);"
    sql = Replace(sql, "@table", Table)
    sql = Replace(sql, "@fields", SqlCombine(Fields))
    sql = Replace(sql, "@values", SqlCombine(Values, Escape))
    SqlInsert = sql
End Function

'---------------------------------------------------------------------------------------
' Procedure : SqlSelect
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/2/2015
' Purpose   : create a SELECT statement using a set of fields
'---------------------------------------------------------------------------------------
'
Public Function SqlSelect(Table As String, Fields As Range, Optional ByVal Criteria As String = "") As String
    Dim sql As String
    sql = "SELECT @fields FROM @table WHERE @criteria;"
    sql = Replace(sql, "@table", Table)
    sql = Replace(sql, "@fields", SqlCombine(Fields))
    sql = Replace(sql, "@criteria", Criteria)
    sql = Replace(sql, " WHERE ;", ";")
    SqlSelect = sql
End Function

'---------------------------------------------------------------------------------------
' Procedure : SqlDelete
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/2/2015
' Purpose   : create a DELETE statement using an IdField name and its value
'---------------------------------------------------------------------------------------
'
Public Function SqlDelete(ByVal Table As String, ByVal IdField As String, ByVal Id As Long) As String
    Dim sql As String

    sql = "DELETE FROM @table WHERE @idfield=@id;"
    sql = Replace(sql, "@table", Table)
    sql = Replace(sql, "@idfield", IdField)
    sql = Replace(sql, "@id", Id)
    SqlDelete = sql
End Function


'---------------------------------------------------------------------------------------
' Procedure : SqlEscape
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/2/2015
' Purpose   : escape a string based on database type
'             e.g. mssql needs two single quotes, mysql needs backspace
'---------------------------------------------------------------------------------------
'
Public Function SqlEscape(ByVal value As String, Optional Escape As eEscape = eNONE) As String
    If Not IsNumeric(value) Then
        Select Case Escape
            Case eMYSQL
                value = "'" & Replace(value, "'", "\'") & "'"
            Case eMSSQL
                value = "'" & Replace(value, "'", "''") & "'"
            Case eNONE
            Case Else
        End Select
    End If
    SqlEscape = value
End Function

'---------------------------------------------------------------------------------------
' Procedure : SqlCombine
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/2/2015
' Purpose   : combine a range of escaped values using "," as a separator
'---------------------------------------------------------------------------------------
'
Public Function SqlCombine(Src As Range, Optional Escape As eEscape = eNONE) As String
    Dim c
    Dim sql As String
    
    sql = ""
    For Each c In Src.Cells
        sql = sql & SqlEscape(c.value, Escape)
        If c.address <> Src(Src.Count).address Then
           sql = sql & ", "
        End If
    Next
    SqlCombine = sql
End Function

'---------------------------------------------------------------------------------------
' Procedure : SqlCombinePairs
' Author    : Michiel van der Blonk (blonkm@gmail.com)
' Date      : 10/2/2015
' Purpose   : combine two ranges A and B
'             e.g. (firstname, lastname) and (john, doe) becomes
'             firstname='john', lastname='doe'
'---------------------------------------------------------------------------------------
'
Public Function SqlCombinePairs(ByVal Rng1 As Range, ByVal Rng2 As Range, Optional Escape As eEscape = eNONE) As String
    Dim c
    Dim sql As String
    Dim key As String
    Dim value As String
    Dim n As Long
    Dim pair As String
    
    If Rng1.Count <> Rng2.Count Then
        Err.Raise vbObjectError + 1, "modSQL", "Rng1 and Rng2 do not match in size"
    End If
    sql = ""
    For n = 1 To Rng1.Count
        key = Rng1(n)
        value = Rng2(n)
        pair = key & " = " & SqlEscape(value, Escape)
        sql = sql & pair
        If n < Rng1.Count Then
            sql = sql & ", "
        End If
    Next
    SqlCombinePairs = sql
End Function