How to update an Excel Table with MySQL data using macros?

Question

Well... my problem is that I am trying to create a macro in VBA to update the values of a table from a database each time I press a button. The connection is local, and I'm using SQL Workbench to manage the database. The table created is:

CCREATE TABLE EMPLEADO
( Cod_empleado    INT           NOT NULL,
  Nombre        VARCHAR(90)     NOT NULL,
  Fecha_inicio    DATE          NOT NULL,
  Referencia      VARCHAR(20)        NULL,
  Direccion       VARCHAR(30)       NOT NULL,
PRIMARY KEY (Cod_empleado));

And it has data on it. So, I've made this macro using an ADODB connection and recordsets ("tEMPLEADO" is the name of the Excel table and "EMPLEADO" is the name of the sheet and the SQL table).

Sub Actualizar_Empleado()
    Sheets("EMPLEADO").Select
    Dim rng As Range
    Set rng = Application.Range("tEMPLEADO")
    Dim con As ADODB.Connection
    Set con = New ADODB.Connection
    con.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=localhost;DATABASE=bdferreteria;USER=PruebaUser;PASSWORD=Passw0rd;"
    Dim com As New ADODB.Command
    com.ActiveConnection = con
    com.CommandText = "SELECT * FROM EMPLEADO"
    com.CommandType = adCmdText
    Dim rs As ADODB.Recordset
    Set rs = com.Execute
    If rs.EOF = False Then
        Dim fila As Integer
        fila = 1
        Do While Not rs.EOF
            Range("B4").EntireRow.Insert
            rng.Cells(fila, 1).Value = rs("Cod_empleado")
            Range("B4").Value = rs("Cod_empleado")
            rng.Cells(fila, 2).Value = rs("Nombre")
            Range("C4").Value = rs("Nombre")
            rng.Cells(fila, 3).Value = rs("Fecha_inicio")
            Range("D4").Value = rs("Fecha_inicio")
            rng.Cells(fila, 4).Value = rs("Referencia")
            Range("E4").Value = rs("Referencia")
            rng.Cells(fila, 5).Value = rs("Direccion")
            Range("D4").Value = rs("Direccion")
            fila = fila + 1
            rs.MoveNext
        Loop
        rs.Close
        con.Close
    Else
        MsgBox "Recordset is empty"
   End If
   
    con.Close

End Sub

The code doesn't throw any errors, but it doesn't do anything, and it should replace all values of the Excel table with the values in the SQL table. And as you can see, I've tried to paste values in two different ways, but none of them work. Thanks in advance.

Answer 1

Give this a shot. This will setup your database connection as a function, accepting inputs of the tab and cell to store the results, and the SQL to execute. Also, no unnecessary looping of records returned from the query:

Public Function adoQuery(targetSheet As String, StartCell As String, sSQL As Variant)
    Dim ws As Worksheet
    Dim myConn As ADODB.Connection
    Dim myRS As ADODB.Recordset
    Set myConn = New ADODB.Connection
    Set myRS = New ADODB.Recordset
    
    Dim strConn As String

    strConn = "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=localhost;" & _
              "DATABASE=bdferreteria;USER=PruebaUser;PASSWORD=Passw0rd;"
              
    Set ws = Worksheets(targetSheet)
    
    myConn.Open strConn
    myRS.Open sSQL, myConn, adOpenStatic, adLockReadOnly, adCmdText

    If Not myRS.EOF Then
        ws.Range(StartCell).CopyFromRecordset myRS
    Else
        MsgBox "No records were returned!"
    End If

    myRS.Close
    myConn.Close

End Function

Then, when working in a sub, you have the flexibility to define a SQL statement you wish to execute without messing with all the connections each time. Here's an example:

Sub GetData()

sSQL = "SELECT * FROM EMPLEADO"

    adoQuery "EMPLEADO", "A1", sSQL

End Sub

Answer 2

Try this:

Sub Actualizar_Empleado()
    
    Dim tbl As ListObject, rng As Range
    Dim con As ADODB.Connection
    Dim com As New ADODB.Command
    Dim rs As ADODB.Recordset
    Dim fila As Long
    
    Set con = New ADODB.Connection
    con.Open "DRIVER={MySQL ODBC 8.0 Unicode Driver};SERVER=localhost;DATABASE=bdferreteria;USER=PruebaUser;PASSWORD=Passw0rd;"
    
    com.ActiveConnection = con
    com.CommandText = "SELECT * FROM EMPLEADO"
    com.CommandType = adCmdText
    
    Set rs = com.Execute
    If Not rs.EOF Then
        
        Set tbl = ThisWorkbook.Sheets("EMPLEADO").ListObjects("tEMPLEADO")
        DeleteTableRows tbl 'remove existing data
        fila = 1
        Do While Not rs.EOF
            If fila = 1 Then
                Set rng = tbl.ListRows(1).Range 'empty row 1 already exists
            Else
                Set rng = tbl.ListRows.Add.Range 'add a new row
            End If
            With rng
                .Cells(1).Value = rs("Cod_empleado").Value
                .Cells(2).Value = rs("Nombre").Value
                .Cells(3).Value = rs("Fecha_inicio").Value
                .Cells(4).Value = rs("Referencia").Value
                .Cells(5).Value = rs("Direccion").Value
            End With
            fila = fila + 1
            rs.MoveNext
        Loop
        rs.Close
        con.Close
    Else
        MsgBox "Recordset is empty"
    End If
   
    con.Close
End Sub

'https://stackoverflow.com/questions/20663491/delete-all-data-rows-from-an-excel-table-apart-from-the-first
Sub DeleteTableRows(ByRef Table As ListObject)
    On Error Resume Next
    '~~> Clear  Row 1 `IF` it exists
    Table.DataBodyRange.Rows(1).ClearContents
    '~~> Delete all the other rows `IF `they exist
    Table.DataBodyRange.Offset(1, 0).Resize(Table.DataBodyRange.Rows.Count - 1, _
                                            Table.DataBodyRange.Columns.Count).Rows.Delete
    On Error GoTo 0
End Sub