# Executing arbitrary SQL statements using VBA in Excel

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:

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
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

Dim ConStr As String

ConStr = "" _
& "Provider=SQLOLEDB.1;" _
& "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"

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 _
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
Sh.Delete
End If

'Create the sheet
With ActiveWorkbook
End With
Sh.Name = ShName

'Execute the SQL statement
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


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.

• 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 – neelsg Aug 17 '18 at 7:22