Practical VBA Examples for the DBA: Part 2

In a previous post I demonstrated how a little bit of VBA code can be used  to build some basic user interfaces to deliver data. Continuing on with this the examples here will show how to build some basic user interfaces; Combo box (or drop down list) and a Multi-Select List. Like the previous examples these use the AdventureWorks sample database as a data source.

Using VBA Combo Boxes with SQL Server

This example will present the user with a drop down list so the user can make a selection and return the appropriate data. To get started first open up Excel.

Click the “Visual Basic” button on the Developer ribbon. N.B. If you can’t see it enable the Developer ribbon.

Firstly we need to add a reference to allow Excel to interact with SQL Server. In the Visual Basic editor click Tools > References and tick the box next to “Microsoft ActiveX Data Objects 2.8 Library”. You’ll get runtime errors if this step isn’t done.

In the project tree right click UserForm > Insert > UserForm. This form should be called UserForm1 (ensure it does as we will be referencing this name in VBA code.)

In the properties dialog for UserForm1 change the value for Caption to “Select a Product”. From the toolbox palette drag and drop and ComboBox and a CommandButton onto the UserForm1. These components should be called ComboBox1 and CommandButton1. You should end up with something that looks like this.

Save your work and close the VBA editor. In the Developer ribbon click the Macros button and add a new macro called comboBox. Add the following code to the macro. Make sure you change the connection string for your environment.

Sub comboBox()

    ' Setup connection string
    Dim connStr As String
    connStr = "driver={sql server};server=localhost\sql2005;"
    connStr = connStr & "Database=AdventureWorks;TrustedConnection=True;"

    ' Setup the connection to the database
    Dim connection As ADODB.connection
    Set connection = New ADODB.connection
    connection.connectionString = connStr
    ' Open the connection
    connection.Open

    ' Open recordset.
    Set Cmd1 = New ADODB.Command
    Cmd1.ActiveConnection = connection
    Cmd1.CommandText = "SELECT Name FROM Production.Product ORDER BY Name"
    Set Results = Cmd1.Execute()

    Results.MoveFirst
    While Not Results.EOF

        ' Fill the Combo box with product names
        UserForm1.ComboBox1.AddItem Results.Fields("Name").Value
        Results.MoveNext

    Wend

    UserForm1.Show

End Sub

This code will select product names from Production.Product and fill the combo box before displaying the form. Go back to UserForm1 and double click the CommandButton. This will open up the VBA code editor. Here we can associated an action with the button. Paste the below code into the editor replacing any code already in there. Change the connection string to point at your SQL Server.

Private Sub CommandButton1_Click()

    Dim selection As String
    ' Get the selected product escaping single quotes
    selection = Replace(UserForm1.ComboBox1.Value, "'", "''")

    ' Setup connection string
    Dim connStr As String
    connStr = "driver={sql server};server=localhost\sql2005;"
    connStr = connStr & "Database=AdventureWorks;TrustedConnection=True;"

    ' Setup the connection to the database
    Dim connection As ADODB.connection
    Set connection = New ADODB.connection
    connection.connectionString = connStr
    ' Open the connection
    connection.Open

    ' Open recordset.
    Set Cmd1 = New ADODB.Command
    Cmd1.ActiveConnection = connection
    Cmd1.CommandText = "SELECT * FROM Purchasing.PurchaseOrderDetail t1 INNER JOIN Production.Product t2 ON t1.ProductID = t2.ProductID AND t2.Name ='" & selection & "'"
    Set Results = Cmd1.Execute()

    ' Clear the data from the active worksheet
    Cells.Select
    Cells.ClearContents

    ' Add column headers to the sheet
    headers = Results.Fields.Count
    For iCol = 1 To headers
        Cells(1, iCol).Value = Results.Fields(iCol - 1).Name
    Next

    ' Copy the resultset to the active worksheet
    Cells(2, 1).CopyFromRecordset Results

    ' Stop running the macro
    Unload Me

End Sub

Save the code and return to Excel. The macro should be ready to run. Click the Macros button on the Developer ribbon. Choose ComboBox and click Run. If all is ok you will see the combobox populated with product names.

Pick “Adjustable Race” and click “Choose Product”. Data should be returned in the open workbook.

Using VBA Multi-Select Lists (ListBox) with SQL Server

This example is very similar to the previous

one but this time we will allow the user to select more than one product by using a Multi-Select list or ListBox.

Follow the same process above to create a new form. This form should be called UserForm2. Add a ListBox and call it listProducts then add a button and call it btnProducts. You should end up with something looking like below;

Save and return to Excel and add a new macro called selectList. Add the following code to the macro. Change the connection string as appropriate.

Sub selectList()

    ' Setup connection string
    Dim connStr As String
    connStr = "driver={sql server};server=localhost\sql2005;"
    connStr = connStr & "Database=AdventureWorks;TrustedConnection=True;"

    ' Setup the connection to the database
    Dim connection As ADODB.connection
    Set connection = New ADODB.connection
    connection.connectionString = connStr
    ' Open the connection
    connection.Open

    ' Open recordset.
    Set Cmd1 = New ADODB.Command
    Cmd1.ActiveConnection = connection
    Cmd1.CommandText = "SELECT Name FROM Production.Product ORDER BY Name"
    Set Results = Cmd1.Execute()

    UserForm2.listProducts.MultiSelect = fmMultiSelectMulti
    Results.MoveFirst
    While Not Results.EOF

        UserForm2.listProducts.AddItem Results.Fields("Name").Value
        Results.MoveNext

    Wend

    UserForm2.Show
End Sub

This code will populate the ListBox with product names and display the form when the macro is executed. Return to the VBA editor and double click on btnProducts. Add the below code and not forgetting to change the connection string.

Private Sub btnProducts_Click()

    Dim selection As String
    ' Get the selected products escaping single quotes
    'selection = Replace(UserForm2.listProducts.Value, "'", "''")
    Dim lItem As Long

    For lItem = 0 To listProducts.ListCount - 1

        If listProducts.Selected(lItem) = True Then

            selection = selection & "'" & Replace(listProducts.List(lItem), "'", "''") & "',"
        End If
    Next

    selection = Mid(selection, 1, Len(selection) - 1)

    ' Setup connection string
    Dim connStr As String
    connStr = "driver={sql server};server=localhost\sql2005;"
    connStr = connStr & "Database=AdventureWorks;TrustedConnection=True;"

    ' Setup the connection to the database
    Dim connection As ADODB.connection
    Set connection = New ADODB.connection
    connection.connectionString = connStr
    ' Open the connection
    connection.Open

    ' Open recordset.
    Set Cmd1 = New ADODB.Command
    Cmd1.ActiveConnection = connection
    Cmd1.CommandText = "SELECT * FROM Purchasing.PurchaseOrderDetail t1 INNER JOIN Production.Product t2 ON t1.ProductID = t2.ProductID AND t2.Name IN (" & selection & ")"
    Set Results = Cmd1.Execute()

    ' Clear the data from the active worksheet
    Cells.Select
    Cells.ClearContents

    ' Add column headers to the sheet
    headers = Results.Fields.Count
    For iCol = 1 To headers
       Cells(1, iCol).Value = Results.Fields(iCol - 1).Name
    Next

    ' Copy the resultset to the active worksheet
    Cells(2, 1).CopyFromRecordset Results

    ' Stop running the macro
    Unload Me

End Sub

Save and return to Excel. The macro should be ready to run. Click the Macros button on the Developer ribbon and run the macro called “selectList”.

Select some products and “Sheet1” should be populated with the appropriate data.

Hopefully this has been easy to follow. I don’t profess to be a VBA expert, or enthusiast,  but I do see its use for quickly building interfaces around your data.