[英]excel VBA to update existing record in SQL
我目前使用以下 VBA 将新记录从 Excel 插入到我的 SQL Server 中。
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
我想要做的是,如果我插入的 sCustomerId 记录发生任何变化,我可以返回并更新它。
所以例如
当前数据集:
sCustomerId = 15 sFirstName = David SLastName = Smith
所以从 excel 我希望它能够输入sCustomerID = 15
然后更新记录SLastName = Warner
关于如何进行此更改的任何想法都会很棒。
像这样的事情应该有效。
在示例中,仅在调试器的即时窗格中打印 SQL。
由于 OP 已经熟悉从数据库中读取数据,因此将其更新留给 OP。
更新以实际更新数据库。
下面显示的代码应位于包含数据的工作表的工作表模块中。
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
下面显示的代码应该在同一个 VBA 项目中的单独模块中。 此代码处理连接和更新客户。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.