如何使用宏将 Excel Table 数据更新为 MySQL 数据？

Question

嗯...我的问题是我试图在 VBA 中创建一个宏，以便在每次按下按钮时从数据库中更新 table 的值。连接是本地的，我正在使用 SQL Workbench 来管理数据库。创建的 table 是：

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

它上面有数据。因此，我使用 ADODB 连接和记录集制作了这个宏（“tEMPLEADO”是 Excel table 的名称，“EMPLEADO”是 sheet 的名称，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

代码没有抛出任何错误，但它什么也没做，它应该用 SQL 中的值替换 Excel table 中的所有值table。如您所见，我尝试以两种不同的方式粘贴值，但其中 none 有效。提前致谢。

Answer 1

试试这个：

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

'
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

Answer 2

试一试。这会将您的数据库连接设置为一个函数，接受选项卡和单元格的输入以存储结果，并执行 SQL 。此外，查询返回的记录没有不必要的循环：

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

然后，当在 sub 中工作时，您可以灵活地定义要执行的 SQL 语句，而不会每次都弄乱所有连接。这是一个例子：

Sub GetData()

sSQL = "SELECT * FROM EMPLEADO"

    adoQuery "EMPLEADO", "A1", sSQL

End Sub

如何使用宏将 Excel Table 数据更新为 MySQL 数据？

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

excel

vba

adodb

recordset