excel VBA 更新 SQL 中的现有记录

Question

I currently have the below VBA to insert new records into my SQL Server from Excel.

Sub Button1_Click()

Dim conn As New ADODB.Connection
Dim iRowNo As Integer
Dim sCustomerId, sFirstName, sLastName As String

With Sheets("Sheet1")

    'Open a connection to SQL Server
    conn.Open "Provider=SQLOLEDB;Data Source=AUSWIDECUSTOMERS\SQL2012;Initial Catalog=Customers;Integrated Security=SSPI;"

    'Skip the header row
    iRowNo = 2

    'Loop until empty cell in CustomerId
    Do Until .Cells(iRowNo, 1) = ""
        sCustomerId = .Cells(iRowNo, 1)
        sFirstName = .Cells(iRowNo, 2)
        sLastName = .Cells(iRowNo, 3)

        'Generate and execute sql statement to import the excel rows to SQL Server table
        conn.Execute "insert into dbo.Customers (CustomerId, FirstName, LastName) values ('" & sCustomerId & "', '" & sFirstName & "', '" & sLastName & "')"

        iRowNo = iRowNo + 1
    Loop

    MsgBox "Customers imported."

    conn.Close
    Set conn = Nothing

End With

End Sub

What I am wanting to do is if anything changes with the sCustomerId record I inserted that I can come back in and update it.

So for example

current data set:

sCustomerId = 15 sFirstName = David SLastName = Smith 

So from excel I want it to be able type in sCustomerID = 15 then update the record SLastName = Warner

Any ideas on how to make this change would be great.

Answer 1

Something like this should work.

In the example only prints the SQL in the Immediate Pane of the debugger. Since the OP is already familiar with reading from the database, updating it is left to the OP.

Updated to actually update the database.

The code presented below should be in the worksheet module for the worksheet containing the data.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rChangableData As Range
    Dim rUpdatedData As Range

    ' Column headings A1, B1, C1
    ' CustomerId in Column A

    ' Range of data that can affect the change B2:C100
    ' This would be better implemented as a named range,
    ' but it is less transparent in the source code what it refers to
    ' * Simply entering a CustomerId, does not add a row
    Set rChangableData = Me.Range("B2:C100")

    ' rUpdatedData is the range of changed data (Target),
    ' intersecting with the range of changable data (rChangeableData).
    ' If the two ranges do not intersect, rUpdatedData is Nothing and the event can be ignored
    Set rUpdatedData = Intersect(rChangableData, Target)

    If Not rUpdatedData Is Nothing Then

        ' Iterate over the range of changed data
        ' Obtain the CustomerId, FirstName and LastName values from the worksheet
        ' Provide to functions to perform the updates
        ' Also added a delete function where there is a CustomerId and no values for FirstName and LastName

        Dim numRows As Long
        Dim rowcounter As Long
        Dim firstRow As Long
        Dim lastRow As Long
        Dim result As Integer

        ' Since the code needs to refer back to data on the worksheet,
        ' it keeps track of the row numbers in on the worksheet, rather than the changed data
        numRows = rUpdatedData.Rows.Count
        firstRow = Target.Row - rChangableData.Row + 1
        rowcounter = firstRow
        lastRow = firstRow + numRows

        While rowcounter < lastRow
            Dim CustomerId As Long
            Dim FirstName As String
            Dim LastName As String
            Dim sql As String

            CustomerId = rChangableData.Offset(0, -1).Cells(rowcounter, 1)
            FirstName = rChangableData.Cells(rowcounter, 1)
            LastName = rChangableData.Cells(rowcounter, 2)

            If Trim(CustomerId) <> "" And Trim(FirstName) <> "" And Trim(LastName) <> "" Then
                ' The data has changed and there are non-blank values for CustomerId, FirstName and LastName;
                ' insert or update the customer

                result = Customer_Update(CustomerId, FirstName, LastName)

                If result = 0 Then
                    MsgBox "No rows were inserted or updated.", vbExclamation, "Customer Update"
                Else
                    If result > 1 Then
                        MsgBox "Multiple rows were updated.", vbExclamation, "Customer Update"
                    End If
                End If
            Else
                If Trim(CustomerId) <> "" And Trim(FirstName) = "" And Trim(LastName) = "" Then
                    ' The data has changed and there is a non-blank value for CustomerID and
                    ' blank values for FirstName and LastName;
                    ' delete the customer

                    Customer_Delete CustomerId

                    If result = 0 Then
                        MsgBox "No rows were deleted", vbExclamation, "Customer Delete"
                    End If
                End If
            End If

            rowcounter = rowcounter + 1
        Wend
    End If
End Sub

The code presented below should be in separate module in the same VBA project. This code handles connecting to and updating the customers.

Option Explicit

Private Function CreateSQLConnection() As ADODB.Connection

    ' Create an ADODB Connection.
    ' Settings depend on your own specific environment

    Dim provider As String
    Dim source As String
    Dim database As String
    Dim credentials As String
    Dim connectionString As String
    Dim sqlConn As ADODB.Connection

    ' Original Connection String
    ' "Provider=SQLOLEDB;Data Source=AUSWIDECUSTOMERS\SQL2012;Initial Catalog=Customers;Integrated Security=SSPI;"

    provider = "SQLOLEDB"
    source = "AUSWIDECUSTOMERS\SQL2012"
    database = "Customers"
    credentials = "Integrated Security=SSPI"
    connectionString = "" & _
        "Provider=" & provider & ";" & _
        "Data Source=" & source & ";" & _
        "Initial Catalogue=" & database & ";" & _
        credentials & ";"

    Set sqlConn = New ADODB.Connection
    sqlConn.Open connectionString
    sqlConn.DefaultDatabase = database
    Set CreateSQLConnection = sqlConn

End Function

Public Function Customer_Update(CustomerId As Long, FirstName As String, LastName As String) As Integer

    ' Update or Insert a customer.
    ' * Creates a connection
    ' * Performs an update to the customer
    ' * Checks the number of rows affected
    ' * If no rows are affected, inserts the customer instead

    Dim sqlConn As ADODB.Connection
    Dim sqlCmd As ADODB.Command
    Dim sqlParam As ADODB.Parameter
    Dim rowsUpdated As Long

    Set sqlConn = CreateSQLConnection()
    Set sqlCmd = New ADODB.Command
    sqlCmd.ActiveConnection = sqlConn
    sqlCmd.CommandType = adCmdText
    sqlCmd.CommandText = "update customer set FirstName = ?, LastName = ? where CustomerId = ?"
    sqlCmd.Parameters.Append sqlCmd.CreateParameter("FirstName", adVarChar, adParamInput, Size:=255, Value:=FirstName)
    sqlCmd.Parameters.Append sqlCmd.CreateParameter("LastName", adVarChar, adParamInput, Size:=255, Value:=LastName)
    sqlCmd.Parameters.Append sqlCmd.CreateParameter("CustomerId", adInteger, adParamInput, Value:=CustomerId)
    sqlCmd.Execute recordsAffected:=rowsUpdated
    Set sqlCmd = Nothing
    Customer_Update = Handle_UpdateInsertDeleteRows(rowsUpdated)

    If Customer_Update = 0 Then
        Dim rowsInserted As Long

        Set sqlCmd = New ADODB.Command
        sqlCmd.ActiveConnection = sqlConn
        sqlCmd.CommandType = adCmdText
        sqlCmd.CommandText = "insert into customer ( CustomerId, FirstName, LastName ) values ( ?, ?, ? )"
        sqlCmd.Parameters.Append sqlCmd.CreateParameter("CustomerId", adInteger, adParamInput, Value:=CustomerId)
        sqlCmd.Parameters.Append sqlCmd.CreateParameter("FirstName", adVarChar, adParamInput, Size:=255, Value:=FirstName)
        sqlCmd.Parameters.Append sqlCmd.CreateParameter("LastName", adVarChar, adParamInput, Size:=255, Value:=LastName)
        sqlCmd.Execute recordsAffected:=rowsInserted
        Customer_Update = Handle_UpdateInsertDeleteRows(rowsInserted)
        Set sqlCmd = Nothing
    End If

    sqlConn.Close
    Set sqlConn = Nothing
End Function

Public Function Customer_Delete(CustomerId As Long) As Integer

    ' Delete a customer.
    ' * Creates a connection
    ' * Performs an delete on the customer table

    Dim sqlConn As ADODB.Connection
    Dim sqlCmd As ADODB.Command
    Dim sqlParam As ADODB.Parameter
    Dim rowsDeleted As Long

    Set sqlConn = CreateSQLConnection()
    Set sqlCmd = New ADODB.Command
    sqlCmd.ActiveConnection = sqlConn
    sqlCmd.CommandType = adCmdText
    sqlCmd.CommandText = "delete customer where CustomerId = ?"
    sqlCmd.Parameters.Append sqlCmd.CreateParameter("CustomerId", adInteger, adParamInput, Value:=CustomerId)
    sqlCmd.Execute recordsAffected:=rowsDeleted
    Set sqlCmd = Nothing
    Customer_Delete = Handle_UpdateInsertDeleteRows(rowsDeleted)
    sqlConn.Close
    Set sqlConn = Nothing
End Function

Private Function Handle_UpdateInsertDeleteRows(recordsAffected As Long) As Integer

    ' Returns:
    ' * 0 for no rows
    ' * 1 for single row
    ' * 2 for multi row

    Select Case recordsAffected
        Case Is <= 0
            Handle_UpdateInsertDeleteRows = 0
        Case Is = 1
            Handle_UpdateInsertDeleteRows = 1
        Case Is > 1
            Handle_UpdateInsertDeleteRows = 2
    End Select

End Function