Advertisement
Guest User

Untitled

a guest
Oct 2nd, 2015
71
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 6.36 KB | None | 0 0
  1. '---------------------------------------------------------------------------------------
  2. ' Module : modSQL
  3. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  4. ' Date : 10/1/2015
  5. ' Purpose : generate SQL queries from Excel cell data
  6. '---------------------------------------------------------------------------------------
  7.  
  8. Option Explicit
  9.  
  10. Enum eEscape
  11. eNONE = 0
  12. eMSSQL = 1
  13. eMYSQL = 2
  14. End Enum
  15.  
  16. '---------------------------------------------------------------------------------------
  17. ' Procedure : SqlUpdate
  18. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  19. ' Date : 10/2/2015
  20. ' Purpose : create an UPDATE statement using
  21. ' a set of fields and
  22. ' a set of values and
  23. ' optional criteria
  24. '---------------------------------------------------------------------------------------
  25. '
  26. 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
  27. Dim sql As String
  28.  
  29. If Fields.Count <> Values.Count Then
  30. Err.Raise vbObjectError + 1, "modSQL", "Fields and Values do not match in size"
  31. End If
  32. sql = "UPDATE @table SET @assignments WHERE @criteria;"
  33. sql = Replace(sql, "@table", Table)
  34. sql = Replace(sql, "@assignments", SqlCombinePairs(Fields, Values, Escape))
  35. sql = Replace(sql, "@criteria", Criteria)
  36. sql = Replace(sql, " WHERE ;", ";")
  37. SqlUpdate = sql
  38. End Function
  39.  
  40. '---------------------------------------------------------------------------------------
  41. ' Procedure : SqlInsert
  42. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  43. ' Date : 10/2/2015
  44. ' Purpose : create an INSERT statement using a set of fields and a set of values
  45. '---------------------------------------------------------------------------------------
  46. '
  47. Public Function SqlInsert(ByVal Table As String, ByVal Fields As Range, ByVal Values As Range, Optional Escape As eEscape = eNONE) As String
  48. Dim sql As String
  49.  
  50. If Fields.Count <> Values.Count Then
  51. Err.Raise vbObjectError + 1, "modSQL", "Fields and Values do not match in size"
  52. End If
  53. sql = "INSERT INTO @table (@fields) VALUES (@values);"
  54. sql = Replace(sql, "@table", Table)
  55. sql = Replace(sql, "@fields", SqlCombine(Fields))
  56. sql = Replace(sql, "@values", SqlCombine(Values, Escape))
  57. SqlInsert = sql
  58. End Function
  59.  
  60. '---------------------------------------------------------------------------------------
  61. ' Procedure : SqlSelect
  62. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  63. ' Date : 10/2/2015
  64. ' Purpose : create a SELECT statement using a set of fields
  65. '---------------------------------------------------------------------------------------
  66. '
  67. Public Function SqlSelect(Table As String, Fields As Range, Optional ByVal Criteria As String = "") As String
  68. Dim sql As String
  69. sql = "SELECT @fields FROM @table WHERE @criteria;"
  70. sql = Replace(sql, "@table", Table)
  71. sql = Replace(sql, "@fields", SqlCombine(Fields))
  72. sql = Replace(sql, "@criteria", Criteria)
  73. sql = Replace(sql, " WHERE ;", ";")
  74. SqlSelect = sql
  75. End Function
  76.  
  77. '---------------------------------------------------------------------------------------
  78. ' Procedure : SqlDelete
  79. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  80. ' Date : 10/2/2015
  81. ' Purpose : create a DELETE statement using an IdField name and its value
  82. '---------------------------------------------------------------------------------------
  83. '
  84. Public Function SqlDelete(ByVal Table As String, ByVal IdField As String, ByVal Id As Long) As String
  85. Dim sql As String
  86.  
  87. sql = "DELETE FROM @table WHERE @idfield=@id;"
  88. sql = Replace(sql, "@table", Table)
  89. sql = Replace(sql, "@idfield", IdField)
  90. sql = Replace(sql, "@id", Id)
  91. SqlDelete = sql
  92. End Function
  93.  
  94.  
  95. '---------------------------------------------------------------------------------------
  96. ' Procedure : SqlEscape
  97. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  98. ' Date : 10/2/2015
  99. ' Purpose : escape a string based on database type
  100. ' e.g. mssql needs two single quotes, mysql needs backspace
  101. '---------------------------------------------------------------------------------------
  102. '
  103. Public Function SqlEscape(ByVal value As String, Optional Escape As eEscape = eNONE) As String
  104. If Not IsNumeric(value) Then
  105. Select Case Escape
  106. Case eMYSQL
  107. value = "'" & Replace(value, "'", "\'") & "'"
  108. Case eMSSQL
  109. value = "'" & Replace(value, "'", "''") & "'"
  110. Case eNONE
  111. Case Else
  112. End Select
  113. End If
  114. SqlEscape = value
  115. End Function
  116.  
  117. '---------------------------------------------------------------------------------------
  118. ' Procedure : SqlCombine
  119. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  120. ' Date : 10/2/2015
  121. ' Purpose : combine a range of escaped values using "," as a separator
  122. '---------------------------------------------------------------------------------------
  123. '
  124. Public Function SqlCombine(Src As Range, Optional Escape As eEscape = eNONE) As String
  125. Dim c
  126. Dim sql As String
  127.  
  128. sql = ""
  129. For Each c In Src.Cells
  130. sql = sql & SqlEscape(c.value, Escape)
  131. If c.address <> Src(Src.Count).address Then
  132. sql = sql & ", "
  133. End If
  134. Next
  135. SqlCombine = sql
  136. End Function
  137.  
  138. '---------------------------------------------------------------------------------------
  139. ' Procedure : SqlCombinePairs
  140. ' Author : Michiel van der Blonk (blonkm@gmail.com)
  141. ' Date : 10/2/2015
  142. ' Purpose : combine two ranges A and B
  143. ' e.g. (firstname, lastname) and (john, doe) becomes
  144. ' firstname='john', lastname='doe'
  145. '---------------------------------------------------------------------------------------
  146. '
  147. Public Function SqlCombinePairs(ByVal Rng1 As Range, ByVal Rng2 As Range, Optional Escape As eEscape = eNONE) As String
  148. Dim c
  149. Dim sql As String
  150. Dim key As String
  151. Dim value As String
  152. Dim n As Long
  153. Dim pair As String
  154.  
  155. If Rng1.Count <> Rng2.Count Then
  156. Err.Raise vbObjectError + 1, "modSQL", "Rng1 and Rng2 do not match in size"
  157. End If
  158. sql = ""
  159. For n = 1 To Rng1.Count
  160. key = Rng1(n)
  161. value = Rng2(n)
  162. pair = key & " = " & SqlEscape(value, Escape)
  163. sql = sql & pair
  164. If n < Rng1.Count Then
  165. sql = sql & ", "
  166. End If
  167. Next
  168. SqlCombinePairs = sql
  169. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement