如何使用宏更新包含 MySQL 数据的 Excel 表？答案

【问题标题】：How to update an Excel Table with MySQL data using macros?如何使用宏更新包含 MySQL 数据的 Excel 表？
【发布时间】：2020-06-25 06:04:04
【问题描述】：

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

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 表的名称，“EMPLEADO”是工作表和 SQL 表的名称）。

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

代码不会抛出任何错误，但它不会做任何事情，它应该将 Excel 表中的所有值替换为 SQL 表中的值。正如您所看到的，我尝试以两种不同的方式粘贴值，但它们都不起作用。提前致谢。

【问题讨论】：

您是否粘贴了错误的 mySQL 表定义？您是否有要更新的工作表上的现有数据，或者您只是添加新行？您的 Excel“表格”是实际的 Table/ListObject，还是只是一个常规的命名范围？
我要更新的Excel表中有已有数据，而我的Excel表是实际表，是的，对不起，我贴错了SQL表，我会及时更正
powerquery 不会为你做这件事吗？
我必须使用记录集执行此操作，但如果没有其他选项，也许我可以尝试使用 powerquery

标签： excel vba adodb recordset

【解决方案1】：

试一试。这会将您的数据库连接设置为一个函数，接受选项卡和单元格的输入来存储结果，以及要执行的 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

【讨论】：

【解决方案2】：

试试这个：

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

【讨论】：