excel VBA to update existing record in SQL - mysql

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