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:

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.