如何在VBA中查找表(SQL Server)中的重复条目



我正在通过VBA代码从Excel工作表插入记录到SQL Server表中,与SQL Server表中的列标题相同。

在SQL Server表中有4列不应该插入已经存在的值。表上的这些列是SF Payroll ID, Unity Payroll元素名称,ICP/LMC元素代码&ICP/LMC元素名称

每次从Excel文件插入每行时,代码需要检查,插入列SF Payroll ID + Unity Payroll Element Name + ICP/LMC Element code + ICP/LMC Element Name的值不存在。

如果行包含与列上已经存在的值相同的值,那么该行应该被拒绝上传到SQL Server表,其余的行应该被上传。

下面是我的代码,上传记录到SQL Server表。请建议如何在VBA代码验证这一点。

Private Sub PushToDB_Click()
Dim conn As ADODB.connection
Dim connString As String
connString = "Provider=SQLOLEDB;Server=DEEPAKSQL;Database=Workload;User Id=DHARMA;Password= ********"
Set conn = New ADODB.connection
conn.Open connString

Dim rowCountsheet As Integer
rowCountsheet = ActiveSheet.UsedRange.Rows.Count
Dim tempisheet As Integer
tempisheet = 2
Dim shsheet As Worksheet
Set shsheet = ThisWorkbook.Worksheets("Data copied")

On Error GoTo CleanFail
conn.BeginTrans
Dim rowCount As Integer
rowCount = ActiveSheet.UsedRange.Rows.Count
Dim tempi As Integer
tempi = 2
Dim sql As String
sql = " INSERT INTO [dbo].[ELEMENT_INFO] ([DB_Upload_Action_Key],[Account_Client_Customer_Name],[SF_Account_ID],[Payroll],[SF_Payroll_ID],[Record_Creation_Date],[Record_Creation_Time_At],[Record_Creation_Guardian_Name],[Record_Last_Modified_Date],[Record_Last_Modified_Time_At],[Record_Last_Modified_Guardian_Name]," _
& "[Unity_Payroll_Element_Name],[Element_Description],[Element_Status],[Element_Type]," _
& "[Element_Input_Classification],[Element_Input_Type],[Element_Frequency]," _
& "[ICP_Or_LMC_Element_Code],[ICP_Or_LMC_Element_Name],[Source_Of_Data_Input_HCM_Integration_EUT_T_A_Other],[GL_Code_Debit],[GL_Code_Credit],[GL_Account_Name],[Comments])" & _
"VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);"

Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Data copied")
Dim pctDone As Single
Dim iLabelWidth As Integer
iLabelWidth = 240
Do Until tempi = rowCount + 1
mapping_upload.Hide
frmProgressForm.Show
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
cmd.CommandText = sql

cmd.Parameters.Append cmd.CreateParameter("DB_Upload_Action_Key", adVarChar, adParamInput, 100, sh.Cells(tempi, 1).Value)
cmd.Parameters.Append cmd.CreateParameter("Account_Client_Customer_Name", adVarChar, adParamInput, 250, sh.Cells(tempi, 2).Value)
cmd.Parameters.Append cmd.CreateParameter("SF_Account_ID", adVarChar, adParamInput, 250, sh.Cells(tempi, 3).Value)
cmd.Parameters.Append cmd.CreateParameter("SF_Payroll_ID", adVarChar, adParamInput, 250, sh.Cells(tempi, 6).Value)
cmd.Parameters.Append cmd.CreateParameter("Record_Creation_Date", adDBDate, adParamInput, 100, dateLabel.Caption) 'sh.Cells(tempi, 10).Value)
cmd.Parameters.Append cmd.CreateParameter("Record_Creation_Time_At", adDBTime, adParamInput, 100, timeLabel.Caption) 'sh.Cells(tempi, 11).Value)
cmd.Parameters.Append cmd.CreateParameter("Record_Creation_Guardian_Name", adVarChar, adParamInput, 100, TextBox1.Text) 'sh.Cells(tempi, 12).Value)
cmd.Parameters.Append cmd.CreateParameter("Record_Last_Modified_Date", adDBDate, adParamInput, 100, dateLabel.Caption) 'sh.Cells(tempi, 13).Value)
cmd.Parameters.Append cmd.CreateParameter("Record_Last_Modified_Time_At", adDBTime, adParamInput, 100, timeLabel.Caption) 'sh.Cells(tempi, 14).Value)
cmd.Parameters.Append cmd.CreateParameter("Record_Last_Modified_Guardian_Name", adVarChar, adParamInput, 100, TextBox1.Text) 'sh.Cells(tempi, 15).Value)
cmd.Parameters.Append cmd.CreateParameter("Unity_Payroll_Element_Name", adVarChar, adParamInput, 3500, sh.Cells(tempi, 16).Value)
cmd.Parameters.Append cmd.CreateParameter("Element_Description", adVarChar, adParamInput, 5000, sh.Cells(tempi, 17).Value)
cmd.Parameters.Append cmd.CreateParameter("Element_Status", adVarChar, adParamInput, 500, sh.Cells(tempi, 18).Value)
cmd.Parameters.Append cmd.CreateParameter("Element_Type", adVarChar, adParamInput, 5000, sh.Cells(tempi, 19).Value)
cmd.Parameters.Append cmd.CreateParameter("Element_Input_Classification", adVarChar, adParamInput, 5000, sh.Cells(tempi, 32).Value)
cmd.Parameters.Append cmd.CreateParameter("Element_Input_Type", adVarChar, adParamInput, 5000, sh.Cells(tempi, 33).Value)
cmd.Parameters.Append cmd.CreateParameter("Element_Frequency", adVarChar, adParamInput, 5000, sh.Cells(tempi, 39).Value)
cmd.Parameters.Append cmd.CreateParameter("ICP_Or_LMC_Element_Code", adVarChar, adParamInput, 5000, sh.Cells(tempi, 40).Value)
cmd.Parameters.Append cmd.CreateParameter("ICP_Or_LMC_Element_Name", adVarChar, adParamInput, 5000, sh.Cells(tempi, 41).Value)
cmd.Parameters.Append cmd.CreateParameter("Source_Of_Data_Input_HCM_Integration_EUT_T_A_Other", adVarChar, adParamInput, 5000, sh.Cells(tempi, 42).Value)
cmd.Parameters.Append cmd.CreateParameter("GL_Code_Debit", adVarChar, adParamInput, 5000, sh.Cells(tempi, 43).Value)
cmd.Parameters.Append cmd.CreateParameter("GL_Code_Credit", adVarChar, adParamInput, 5000, sh.Cells(tempi, 44).Value)
cmd.Parameters.Append cmd.CreateParameter("GL_Account_Name", adVarChar, adParamInput, 5000, sh.Cells(tempi, 45).Value)
cmd.Parameters.Append cmd.CreateParameter("Comments", adVarChar, adParamInput, 8000, sh.Cells(tempi, 50).Value)
cmd.Execute
tempi = tempi + 1
pctDone = (tempi - 1) / rowCount
frmProgressForm.lblProgress.Width = iLabelWidth * pctDone
frmProgressForm.FrameProgress.Caption = Format(pctDone, "0%")
DoEvents
Loop
Unload frmProgressForm
MsgBox "Data Loaded Successfully to T-1 DataBase", vbInformation, "SDD04 - Commit Transaction, Okay!"
mapping_upload.Show
conn.CommitTrans
CleanExit:
conn.Close
Exit Sub

CleanFail:
conn.RollbackTrans
MsgBox "Input file error either value exceeds or having wrong type. Transaction was rolled back. " & Err.Description, vbCritical, "SDD04 - Input error"
Unload frmProgressForm
Debug.Print Err.Number, Err.Description
Resume CleanExit
End Sub

您正在使用一个循环来访问每一行,并构建INSERT INTO语句。这是对的,但是我没有看到任何代码试图检查您需要什么:如果该行在插入之前已经存在。

因此,在插入每一行之前,您需要检查它是否存在于SQL表中。由于您必须对每一行执行此操作,因此在构建INSERT语句之前,您应该在循环中做的第一件事是构建SELECT语句来执行检查,然后,根据结果,您将执行INSERT或不执行INSERT。

我想你可以从VBA建立一个SELECT语句,如果你能够建立一个INSERT语句。否则你可以寻求帮助。

添加:2022-05-20

下面的代码片段可以帮助您使用SELECT语句。

Private Sub Test()
Dim cnn As New ADODB.Connection
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
Dim ConnectionString As String
Dim strSql As String
ConnectionString = "Provider=SQLOLEDB;Server=DEEPAKSQL;Database=Workload;User Id=DHARMA;Password= ********"
strSql = "SELECT * FROM [dbo].[ELEMENT_INFO] WHERE [SF Payroll ID]=" & Value1 & " AND [Unity Payroll Element Name]='" & Value2 & "' AND ..."
rst.CursorLocation = adUseClient ' Client-side cursor
rst.Open strSql, cnn
If Not rst.RecordCount > 0 Then
'Not Exists -> Do the Insert
Else
'Exists -> Don't do the Insert
End If
rst.Close
Set rst = Nothing
End Sub

最新更新