Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- '---------------------------------------------------------------------------------------
- ' 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement