Executing arbitrary SQL statements using VBA in Excel

Question

I built a workbook to help me extract data from a MSSQL database into Excel. I realize that this is fairly easy to do with Microsoft SQL Server Management Studio, but I can't easily get that installed on my machine at work, so I first have to remote to the server every time to get any data, which becomes a mission if you have to do it often.

The workbook has a small control sheet as follows: Workbook Control Sheet

The button calls Sub ExecSQL() which will scan this sheet for SQL statements, execute them and then paste the results into the corresponding sheet. In this example, it will execute one SELECT statement and paste the result into Fct201712.

I know about SQL injection, but given that I won't be giving this out to users and the SQL auths I use anyway do not have write access to the database, I'm not too concerned about that.

I'm trying to implement some of the suggestions I received on this previous question. Given how I now handle errors, I am not closing the DB connection if I get an error. How can I elegantly structure my code so that I always close the connection even if I get an error without using GoTo?

Any other advice on how to improve this code will be greatly appreciated. Also, if you think I'm making the code too complicated, please let me know

Here is the full module:

Option Explicit
Sub ExecSQL()
 Dim ActSh As Worksheet
 Set ActSh = ActiveSheet
 'Connect to the database
 Dim Conn As ADODB.Connection
 Set Conn = NewDBConnection()
 'Get the SQL statements and Worksheets from this sheet
 Dim Stmt As Scripting.Dictionary
 Set Stmt = GetStatements()
 If Not CheckStatements(Stmt) Then Exit Sub
 'Execute the SQL commands and paste the results
 Dim Sh As Variant
 For Each Sh In Stmt.Keys()
 If Not ExecSQLStmt(Conn, Sh, Stmt(Sh)) Then Exit Sub
 Next
 'Clean up
 Conn.Close
 Set Conn = Nothing
 ActSh.Activate
 MsgBox "SQL statement execution completed", vbInformation + vbOKOnly, "Completed"
End Sub
Private Function NewDBConnection() As ADODB.Connection
 Dim ConStr As String
 ConStr = "" _
 & "Provider=SQLOLEDB.1;" _
 & "Password={redacted};" _
 & "Persist Security Info=True;" _
 & "User ID={redacted};" _
 & "Initial Catalog={redacted};" _
 & "Data Source={redacted};" _
 & "Use Procedure for Prepare=1;" _
 & "Auto Translate=True;" _
 & "Packet Size=4096;" _
 & "Workstation ID=W530;" _
 & "Use Encryption for Data=False;" _
 & "Tag with column collation when possible=False"
 Dim Conn As ADODB.Connection
 Set Conn = New ADODB.Connection
 Conn.Open ConStr
 Set NewDBConnection = Conn
End Function
Private Function GetStatements() As Scripting.Dictionary
 Dim Rng As Range
 Set Rng = ActiveSheet.UsedRange
 Dim Row As Long
 Dim RowHdr As Long
 Dim RowCount As Long
 RowHdr = 0
 RowCount = Rng.Rows.Count
 Dim Col As Long
 Dim ColSh As Long
 Dim ColSQL As Long
 Dim ColCount As Long
 ColSh = 0
 ColSQL = 0
 ColCount = Rng.Columns.Count
 'Get the header row and applicable columns
 Dim ValHdr As String
 For Row = 1 To RowCount
 For Col = 1 To ColCount
 ValHdr = UCase(Trim(GetStrValue(Rng.Cells(Row, Col))))
 If ValHdr = "!SHEET" Then
 RowHdr = Row
 ColSh = Col
 ElseIf ValHdr = "!SQL" Then
 RowHdr = Row
 ColSQL = Col
 End If
 Next
 If RowHdr > 0 Then Exit For
 Next
 'Scan the rows for any applicable entries
 Dim Stmt As Scripting.Dictionary
 Set Stmt = New Scripting.Dictionary
 Dim ValSh As String
 Dim ValSQL As String
 If ColSh > 0 And ColSQL > 0 Then
 For Row = RowHdr + 1 To RowCount
 ValSh = Trim(GetStrValue(Rng.Cells(Row, ColSh)))
 ValSQL = Trim(GetStrValue(Rng.Cells(Row, ColSQL)))
 If ValSh <> "" And ValSQL <> "" Then
 Stmt(ValSh) = ValSQL
 End If
 Next
 End If
 Set GetStatements = Stmt
End Function
Private Function CheckStatements(Stmt As Scripting.Dictionary) As Boolean
 Dim ErrStr As String
 ErrStr = ""
 If Stmt.Count = 0 Then
 ErrStr = "Could not find any SQL statements on the current sheet." _
 & vbCrLf _
 & "Did you remember to add ""!Sheet"" and ""!SQL"" header tags?"
 End If
 If ErrStr = "" Then
 CheckStatements = True
 Else
 MsgBox ErrStr, vbCritical + vbOKOnly, "Error"
 CheckStatements = False
 End If
End Function
Private Function GetStrValue(Rng As Range) As String
 'Get the value of a cell, but do not throw and error if the cell
 'contains and error. Intead, just return an empty string
 Dim Val As String
 Val = ""
 On Error Resume Next
 Val = Rng.Value
 On Error GoTo 0
 GetStrValue = Val
End Function
Private Function ExecSQLStmt(Conn As ADODB.Connection, ByVal ShName As String, SQLStmt As String) As Boolean
 'Execute the SQL statement and paste the result into the corresponding sheet
 Dim Sh As Worksheet
 'Delete the sheet if it already exists
 On Error Resume Next
 Set Sh = ActiveWorkbook.Worksheets(ShName)
 On Error GoTo 0
 If Not Sh Is Nothing Then
 Application.DisplayAlerts = False
 Sh.Delete
 Application.DisplayAlerts = True
 End If
 'Create the sheet
 With ActiveWorkbook
 Set Sh = .Sheets.Add(After:=.Sheets(.Sheets.Count))
 End With
 Sh.Name = ShName
 'Execute the SQL statement
 Dim Rs As ADODB.Recordset
 On Error Resume Next
 Set Rs = Conn.Execute(SQLStmt)
 If Rs Is Nothing Then
 Dim ErrStr As String
 ErrStr = "There was an error executing the SQL statement" & vbCrLf _
 & SQLStmt & vbCrLf _
 & vbCrLf _
 & "Error: " & Err.Description
 MsgBox ErrStr, vbCritical + vbOKOnly, "Error"
 ExecSQLStmt = False
 Exit Function
 End If
 On Error GoTo 0
 'Paste the result into the sheet
 Dim Col As Long
 For Col = 1 To Rs.Fields.Count
 Sh.Cells(1, Col).Value = Rs.Fields(Col - 1).Name
 Next
 Sh.Cells(1, 1).EntireRow.Font.Bold = True
 Sh.Range("A2").CopyFromRecordset Rs
 ExecSQLStmt = True
End Function

Answer 1

Everytime you pass something without ByVal you are passing it ByRef, which is general, isn't necessary.

I also see you passing a Scripting.Dictionary around, ByRef. I'd pass this as an object, but I also always use late-binding. I think this indicates you should create a custom Class to replace the dictionary.

Private Function GetStatements() As Scripting.Dictionary

It's strange to pass nothing to a function. It's a function because you're creating and returning the object. Even if you just pass UsedRange it would make more sense, though I see how you ended up there.

Private Function NewDBConnection() As ADODB.Connection

It looks to me like you could just have your connection string as a constant and you could open the connection without this entire function. However, I don't think that would be better than this - if just for readability and clarity.

Variables

You have a lot of pretty generically named variables e.g. Conn, Rng, etc. You're also using ProperCase for variables, when they should use camelCase. So if we were to evaluate your variables

Dim ActSh As Worksheet 

This is ActiveSheet, a built-in variable, I don't think it's needed. If it is, then it needs to tell me what's on the sheet.

Dim Conn As ADODB.Connection

I mean, this is okay..

Dim Stmt As Scripting.Dictionary

Why would a statement be a dictionary? You've lost me with this name

Dim Sh As Variant

This is a key right?

Dim ConStr As String

connectionString is better

Dim Rng As Range

Tell me what range this is - I know it's a range when you declare it as a range

Dim Row As Long

I avoid using things like Row or Column because they are key words in the VBE. I usually go with targetRow or currentRow

Dim RowHdr As Long

Characters are free! rowHeader would be better, but it sounds like a string, not a long. headerRow sounds better.

Dim RowCount As Long rowCount
Dim Col As Long targetColumn
Dim ColSh As Long
Dim ColSQL As Long

I'm not sure what these are - use the name to tell me what I want to know!

Dim ColCount As Long columnCount
Dim ValHdr As String
Dim ValSh As String
Dim ValSQL As String

Same, tell me what these are!

Dim Val As String

A value as a string. You know what I'm going to say, right? Dim Sh As Worksheet ? Dim Rs As ADODB.Recordset I see this a lot, so I guess it's okay

Function Names

Private Function ExecSQLStmt(Conn As ADODB.Connection, ByVal ShName As String, SQLStmt As String) As Boolean

This is an execute function that returns a boolean - why? Either it's executing and returns nothing, or it's executing and returning a result, right?

Private Function CheckStatements(Stmt As Scripting.Dictionary) As Boolean

If this is a boolean function, try to name it as such e.g. IsValidStatement or some such.

GetStatements

With the variable naming as it is, it's very difficult to tell exactly what's happening upon a cursory glance.

• With usedrange
• for each row
• for each column
• check if cell = !SHEET or !SQL
• Set sheet or statement
• If we're not on row 1, exit for

Seems your first check would just be to loop through only the rows you want, instead of looping through everything just to exit on row 2? I mean it's difficult to tell what exactly the goal is, but if you just want the header row to be row 1, why not just get row 1? You're setting these values within the If but then looping and replacing them without doing anything with them.

• If there's both a header and a statement then
• Get range values and place them into the dictionary, if they aren't empty

Seems pretty straight forward. In fact, you could just take everything into an array first and you wouldn't need the dictionary

Private Function GetMyValues(ByVal target As Range) As Variant
 GetMyValues = target
End Function

Bam! No need to look at the sheet again. Now you can loop through the array and store your results in another array or just expand your current array. Then when you are done, print them back out as an array.

Error handling?

Private Function GetStrValue(Rng As Range) As String
 'Get the value of a cell, but do not throw and error if the cell
 'contains and error. Intead, just return an empty string
 Dim Val As String
 Val = ""
 On Error Resume Next
 Val = Rng.value
 On Error GoTo 0
 GetStrValue = Val
End Function

When you declare a string it is declared as vbNullString which is a constant for your "". So, first, no need to set it to anything if it's going to be nothing. Second, always use vbNullString when you can instead of ""

Third, I don't see a way for this to throw an error, unless you don't pass it a valid range. This function, as far as I can see, not needed at all.

• neelsg: Thanks for this. I appreciate the help and will try to adapt going forward. Just to explain some of the reasoning: (1) The loop to get headers goes through the whole sheet, but escapes when found because it makes it possible to move things around without breaking the code. The header row could be 1, 2 or 10. The same for columns. (2) I'm returning boolean on ExecSQLStmt as a way to pass errors. I think this could be done better, but I'm not yet sure how. (3) The reason for error handling is if you do {StringVariable} = Rng.Value on a cell containing an error it will throw an error in VBA