在插入之前删除 SQL 服务器 table 中的记录
Deleting Records in SQL server table prior to insert
我有一个 excel 工作簿，它是一个项目计划模板，PM 填写信息并将其加载到 sql 数据库中。目前，如果通过批处理加载两个 tables（1 有 1 行数据，另一个有多条记录），则该过程。我正在将其更改为通过 vba 从 excel 直接插入到 sql 服务器。我有插入工作，但每个 table 都有一个项目 ID 列，它是 PK。 pm 可能会多次更新和保存此文件。 tables 更新为最新的保存信息。我通过在我的代码中添加删除语句然后插入更新的记录来解决这个问题。这对于具有 1 条记录的 table 非常有效，但我无法使具有多条记录的 table 起作用。它删除记录并通过插入的第一个循环，然后返回到删除并删除记录。
我附上了多次 table 删除和插入的代码。有人可以告诉我我做错了什么吗？
Public Sub exportprojdetaildata()
Dim stSQL As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim iRowNo As Integer
Dim targetedFieldNames As Variant
Dim rowData As Variant
Dim lastrow As Long
Dim sql As String
Dim i As Integer
Dim cvt As Double
Dim aField As String
Dim compare As Variant
Dim value As Variant
Dim dvalue As Long
With Sheets("Data")
lastrow = .Range("A:A").Find(what:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
'Open a connection to SQL Server
conn.Open _
"Provider=SQLOLEDB;Data Source=PWIRTPAUDD1HV8;Initial Catalog=STAR;User Id=STAR_USER;Password=dcistarrtp"
'Skip the header row
iRowNo = 2
targetedFieldNames = Join(WorksheetFunction.Transpose(wks_TargetFieldNames.Range("targetedFieldNames").value), "," & vbNewLine)
Do While iRowNo <= lastrow
rowData = wks_BackgroundData.Range("A" & iRowNo & ":AV" & iRowNo).value
compare = wks_BackgroundData.Range("AV2").value
'Generate and execute sql statement to import the excel rows to SQL Server table
With rs
.ActiveConnection = conn
.Open "Select proj_id from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & compare
wks_BackgroundData.Range("BA2").CopyFromRecordset rs
.Close
End With
value = wks_BackgroundData.Range("BA2").value
If compare = value Then
sql = "delete from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & value
conn.Execute sql
Else
sql = "insert into dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy ("
sql = sql & targetedFieldNames
' Debug.Print sql
sql = sql & ") values (" & vbNewLine
' Debug.Print sql
'couldn't do transpose since rowData represents a row, not a column
For i = 1 To UBound(rowData, 2)
aField = Replace(rowData(1, i), "'", "''")
'escape single quotes
Select Case i
Case 1, 6, 16, 17, 23 To 47
' cvt = CDbl(aField)
If aField = vbNullString Then
sql = sql & "Null," & vbNewLine
Else
sql = sql & aField & "," & vbNewLine
End If
Case 2 To 5, 7 To 15, 18 To 22
sql = sql & "'" & aField & "', " & vbNewLine
Case 48
If aField = vbNullString Then
sql = sql & "Null"
Else
sql = sql & aField
End If
End Select
Next i
sql = sql & ");"
'sql = sql & "');"
' End If
conn.Execute sql
iRowNo = iRowNo + 1
Loop
End If
conn.Close
Set conn = Nothing
End With
结束子
避免使用 VBA 进行新的开发工作。如果您需要不断获取此 Excel 文档并将其插入 SQL 服务器数据库，则 use SSIS and some C# to easily make it a scheduled task via the SQL Agent, or simply do as the screen shot below suggests, which is a no-code and easily configurable import of flat files / database tables into SQL Server. Lastly, from a usability standpoint, There are many better methods to track Excel sheets or forms data (SharePoint, Excel 2013, Access, cloud/on premise drives) or using an internal WordPress distribution with some plugins like WP-document revisions。
没有看到你试图保存的数据很难确定，但我怀疑你有逻辑错误。
rowData 的值是在循环中动态建立的。这是正确的。
rowData = wks_BackgroundData.Range("A" & iRowNo & ":AV" & iRowNo).value
但是 compare 和 value 的值总是从循环内的相同位置读取。所以delete语句会被反复执行
compare = wks_BackgroundData.Range("AV2").value
value = wks_BackgroundData.Range("BA2").value
不应该动态读取比较和值吗？
compare = wks_BackgroundData.Range("AV" & iRowNo).value
value = wks_BackgroundData.Range("BA" & iRowNo).value
或
您应该将 delete 语句移到循环之外，以确保它只执行一次
或者
你应该保留一个标志，表明删除已经被执行，并且不再执行它。
hasExecuted = false <- OUTSIDE THE LOOP
...
...
If compare = value and hasExecuted = false Then
sql = "delete from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & value
conn.Execute sql
hasExecuted = true
...
...
此外，我认为您不应该使用 IF x=y THEN 删除 ELSE INSERT。不应该是 IF x=y THEN 删除，总是 INSERT。如果是else，则只有记录不存在才会插入，如果删除了记录，则永远不会插入新记录。
希望有点帮助
如上所述，我使用 Spock 添加动态查找比较和值变量的值。一旦我这样做了，我就添加了 hasExecuted 标志。
Public Sub exportprojinfodata()
Dim stSQL As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim iRowNo As Integer
Dim targetFieldNames As Variant
Dim rowData As Variant
Dim lastrow As Long
Dim sql As String
Dim i As Integer
Dim aField As String
Dim compare As Variant
Dim value As Variant
Dim hasExecuted As String
hasExecuted = False
With Sheets("Data2")
lastrow = .Range("A:A").Find(what:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
'Open a connection to SQL Server
conn.Open _
"Provider=SQLOLEDB;Data Source=PWIRTPAUDD1HV8;Initial Catalog=STAR;User Id=STAR_USER;Password=dcistarrtp"
'Skip the header row
iRowNo = 2
targetFieldNames = Join(WorksheetFunction.Transpose(wks_TargetFieldNames.Range("TargetFieldNames").value), "," & vbNewLine)
Do While iRowNo <= lastrow
rowData = wks_ProjDescription.Range("A" & iRowNo & ":AO" & iRowNo).value
compare = wks_ProjDescription.Range("B"& iRowNo).value
'Generate and execute sql statement to import the excel rows to SQL Server table
With rs
.ActiveConnection = conn
.Open "Select proj_id from dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy where proj_id= " & compare
wks_ProjDescription.Range("AX2").CopyFromRecordset rs
.Close
End With
value = wks_ProjDescription.Range("AX"& iRowNo).value
If compare = value And hasExecuted = False Then
stSQL = "delete from dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy where proj_id = " & value
conn.Execute stSQL
hasExecuted = True
End If
sql = "insert into dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy ("
sql = sql & targetFieldNames
sql = sql & ") values (" & vbNewLine
'
'couldn't do transpose since rowData represents a row, not a column
For i = 1 To UBound(rowData, 2)
aField = Replace(rowData(1, i), "'", "''")
Select Case i
Case 1 To 40
sql = sql & "'" & aField & "', " & vbNewLine
Case 41
If aField Like "*,*" Then
sql = sql & "'" & """" & aField & """" & vbNewLine
Else
sql = sql & "'" & aField & "' " & vbNewLine
End If
End Select
Next i
sql = sql & ");"
' sql = sql & "');"
conn.Execute sql
iRowNo = iRowNo + 1
Loop
conn.Close
Set conn = Nothing
End With
End Sub
我有一个 excel 工作簿，它是一个项目计划模板，PM 填写信息并将其加载到 sql 数据库中。目前，如果通过批处理加载两个 tables（1 有 1 行数据，另一个有多条记录），则该过程。我正在将其更改为通过 vba 从 excel 直接插入到 sql 服务器。我有插入工作，但每个 table 都有一个项目 ID 列，它是 PK。 pm 可能会多次更新和保存此文件。 tables 更新为最新的保存信息。我通过在我的代码中添加删除语句然后插入更新的记录来解决这个问题。这对于具有 1 条记录的 table 非常有效，但我无法使具有多条记录的 table 起作用。它删除记录并通过插入的第一个循环，然后返回到删除并删除记录。
我附上了多次 table 删除和插入的代码。有人可以告诉我我做错了什么吗？
Public Sub exportprojdetaildata()
Dim stSQL As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim iRowNo As Integer
Dim targetedFieldNames As Variant
Dim rowData As Variant
Dim lastrow As Long
Dim sql As String
Dim i As Integer
Dim cvt As Double
Dim aField As String
Dim compare As Variant
Dim value As Variant
Dim dvalue As Long
With Sheets("Data")
lastrow = .Range("A:A").Find(what:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
'Open a connection to SQL Server
conn.Open _
"Provider=SQLOLEDB;Data Source=PWIRTPAUDD1HV8;Initial Catalog=STAR;User Id=STAR_USER;Password=dcistarrtp"
'Skip the header row
iRowNo = 2
targetedFieldNames = Join(WorksheetFunction.Transpose(wks_TargetFieldNames.Range("targetedFieldNames").value), "," & vbNewLine)
Do While iRowNo <= lastrow
rowData = wks_BackgroundData.Range("A" & iRowNo & ":AV" & iRowNo).value
compare = wks_BackgroundData.Range("AV2").value
'Generate and execute sql statement to import the excel rows to SQL Server table
With rs
.ActiveConnection = conn
.Open "Select proj_id from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & compare
wks_BackgroundData.Range("BA2").CopyFromRecordset rs
.Close
End With
value = wks_BackgroundData.Range("BA2").value
If compare = value Then
sql = "delete from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & value
conn.Execute sql
Else
sql = "insert into dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy ("
sql = sql & targetedFieldNames
' Debug.Print sql
sql = sql & ") values (" & vbNewLine
' Debug.Print sql
'couldn't do transpose since rowData represents a row, not a column
For i = 1 To UBound(rowData, 2)
aField = Replace(rowData(1, i), "'", "''")
'escape single quotes
Select Case i
Case 1, 6, 16, 17, 23 To 47
' cvt = CDbl(aField)
If aField = vbNullString Then
sql = sql & "Null," & vbNewLine
Else
sql = sql & aField & "," & vbNewLine
End If
Case 2 To 5, 7 To 15, 18 To 22
sql = sql & "'" & aField & "', " & vbNewLine
Case 48
If aField = vbNullString Then
sql = sql & "Null"
Else
sql = sql & aField
End If
End Select
Next i
sql = sql & ");"
'sql = sql & "');"
' End If
conn.Execute sql
iRowNo = iRowNo + 1
Loop
End If
conn.Close
Set conn = Nothing
End With
结束子
避免使用 VBA 进行新的开发工作。如果您需要不断获取此 Excel 文档并将其插入 SQL 服务器数据库，则 use SSIS and some C# to easily make it a scheduled task via the SQL Agent, or simply do as the screen shot below suggests, which is a no-code and easily configurable import of flat files / database tables into SQL Server. Lastly, from a usability standpoint, There are many better methods to track Excel sheets or forms data (SharePoint, Excel 2013, Access, cloud/on premise drives) or using an internal WordPress distribution with some plugins like WP-document revisions。
没有看到你试图保存的数据很难确定，但我怀疑你有逻辑错误。
rowData 的值是在循环中动态建立的。这是正确的。
rowData = wks_BackgroundData.Range("A" & iRowNo & ":AV" & iRowNo).value
但是 compare 和 value 的值总是从循环内的相同位置读取。所以delete语句会被反复执行
compare = wks_BackgroundData.Range("AV2").value
value = wks_BackgroundData.Range("BA2").value
不应该动态读取比较和值吗？
compare = wks_BackgroundData.Range("AV" & iRowNo).value
value = wks_BackgroundData.Range("BA" & iRowNo).value
或
您应该将 delete 语句移到循环之外，以确保它只执行一次
或者
你应该保留一个标志，表明删除已经被执行，并且不再执行它。
hasExecuted = false <- OUTSIDE THE LOOP
...
...
If compare = value and hasExecuted = false Then
sql = "delete from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & value
conn.Execute sql
hasExecuted = true
...
...
此外，我认为您不应该使用 IF x=y THEN 删除 ELSE INSERT。不应该是 IF x=y THEN 删除，总是 INSERT。如果是else，则只有记录不存在才会插入，如果删除了记录，则永远不会插入新记录。
希望有点帮助
如上所述，我使用 Spock 添加动态查找比较和值变量的值。一旦我这样做了，我就添加了 hasExecuted 标志。
Public Sub exportprojinfodata()
Dim stSQL As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConn As String
Dim iRowNo As Integer
Dim targetFieldNames As Variant
Dim rowData As Variant
Dim lastrow As Long
Dim sql As String
Dim i As Integer
Dim aField As String
Dim compare As Variant
Dim value As Variant
Dim hasExecuted As String
hasExecuted = False
With Sheets("Data2")
lastrow = .Range("A:A").Find(what:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
'Open a connection to SQL Server
conn.Open _
"Provider=SQLOLEDB;Data Source=PWIRTPAUDD1HV8;Initial Catalog=STAR;User Id=STAR_USER;Password=dcistarrtp"
'Skip the header row
iRowNo = 2
targetFieldNames = Join(WorksheetFunction.Transpose(wks_TargetFieldNames.Range("TargetFieldNames").value), "," & vbNewLine)
Do While iRowNo <= lastrow
rowData = wks_ProjDescription.Range("A" & iRowNo & ":AO" & iRowNo).value
compare = wks_ProjDescription.Range("B"& iRowNo).value
'Generate and execute sql statement to import the excel rows to SQL Server table
With rs
.ActiveConnection = conn
.Open "Select proj_id from dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy where proj_id= " & compare
wks_ProjDescription.Range("AX2").CopyFromRecordset rs
.Close
End With
value = wks_ProjDescription.Range("AX"& iRowNo).value
If compare = value And hasExecuted = False Then
stSQL = "delete from dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy where proj_id = " & value
conn.Execute stSQL
hasExecuted = True
End If
sql = "insert into dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy ("
sql = sql & targetFieldNames
sql = sql & ") values (" & vbNewLine
'
'couldn't do transpose since rowData represents a row, not a column
For i = 1 To UBound(rowData, 2)
aField = Replace(rowData(1, i), "'", "''")
Select Case i
Case 1 To 40
sql = sql & "'" & aField & "', " & vbNewLine
Case 41
If aField Like "*,*" Then
sql = sql & "'" & """" & aField & """" & vbNewLine
Else
sql = sql & "'" & aField & "' " & vbNewLine
End If
End Select
Next i
sql = sql & ");"
' sql = sql & "');"
conn.Execute sql
iRowNo = iRowNo + 1
Loop
conn.Close
Set conn = Nothing
End With
End Sub