Adodb 提交和回滚 Excel VBA

Question

继续我之前的问题。经过大量研究，我发现将数据从 Excel 插入 SQL Server 的方法是最有效的，代码如下。

我真正想要建议的是如何设置 ADODB 提交和回滚。我不确定这是否可能，因为我的代码通过 FOR 循环将数据插入 SQL Server，并且我认为提交和回滚需要在一次 SQL 执行中完成？

代码

Pre-loop code
            For i = 7 To LastRow

            'Check if it was sent - then skip iteration
                    With Worksheets("Admin")
                        If .Cells(i, 5).Value = "Y" Then
                            GoTo NextIteration
                        Else
                            Command.CommandText = "INSERT INTO [dbo].[TEP_Payments_Table] ([AA Number], [AA Name], [AA Role], [Project Name], [Series], [Paper No], [Task Name], [Amount], [Payment Justification], [Payment Identifier], [Date of Activity], [Half Day / Full Day], [Teacher Release (Y/N)], [Centre No], [Request Receipt Id], [Request Date], [Requested By], [Business Unit]) VALUES (" & _
"'" & Sheets("Project_Name").Cells(i, 2).Value & "'," & _
"'" & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 3).Value, "'", ""), "*", ""), Chr(34), "") & "'," & _
"'" & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 4).Value, "'", ""), "*", ""), Chr(34), "") & "'," & _
"'" & Sheets("Project_Name").Cells(i, 5).Value & "'," & _
"'" & Sheets("Project_Name").Cells(i, 6).Value & "'," & _
"'" & Sheets("Project_Name").Cells(i, 7).Value & "'," & _
"'" & Sheets("Project_Name").Cells(i, 8).Value & "'," & _
"'" & Sheets("Project_Name").Cells(i, 9).Value & "'," & _
"'" & "Description: " & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 10).Value, "'", ""), "*", ""), Chr(34), "") & vbNewLine & vbNewLine & _
"  //Project: " & Sheets("Project_Name").Cells(i, 5).Value & vbNewLine & _
"  //Series: " & Sheets("Project_Name").Cells(i, 6).Value & vbNewLine & _
"  //Paper No: " & Sheets("Project_Name").Cells(i, 7).Value & vbNewLine & _
" //Task Name: " & Sheets("Project_Name").Cells(i, 8).Value & "'," & _
"'" & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 12).Value, "'", ""), "*", ""), Chr(34), "") & "'," & _
"'" & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 13).Value, "'", ""), "*", ""), Chr(34), "") & "'," & _
"'" & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 14).Value, "'", ""), "*", ""), Chr(34), "") & "'," & _
"'" & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 15).Value, "'", ""), "*", ""), Chr(34), "") & "'," & _
"'" & Replace(Replace(Replace(Sheets("Project_Name").Cells(i, 16).Value, "'", ""), "*", ""), Chr(34), "") & "'," & _
"'" & .Cells(i, 22).Value & "'," & _
"'" & Format(Now(), "yyyy-MM-dd hh:mm:ss") & "'," & _
"'" & Application.UserName & "'," & _
"'" & .Cells(i, 20).Value & "')"


                                'replace(replace(replace(Sheets("Project_Name").Cells(i, 10).Value,"'",""),"*",""),Chr(34),"")

                            Command.Execute

                            'Mark what was inserted with "Y"
                                .Cells(i, 5).Value = "Y"
                                Sheets("Project_Name").Cells(i, 19).Value = 

"Y"
'''''' After loop code ''''

编辑

我修改后的代码是：

Private Sub insertAll()

    Dim Conn As ADODB.Connection
    Dim output As Integer
    Dim i As Long
    Dim LastRow As Long

    LastRow = Sheets("Project_Name").Cells(Rows.count, "B").End(xlUp).row

    Set Conn = New ADODB.Connection

        Conn.ConnectionString = "Provider=SQLOLEDB; Data Source=LO1WPFSASDB001;Initial Catalog=Londonmi01;User ID=SSRSuser;Password=ssrsuser1; Trusted_Connection=no"
        Conn.Open

        On Error GoTo CleanFail
        Conn.BeginTrans

        Dim sql As String
        sql = "INSERT INTO [dbo].[TEP_Payments_Table] ([AA Number], [AA Name], [AA Role], [Project Name], [Series], [Paper No], [Task Name], [Amount], [Payment Justification], [Payment Identifier], [Date of Activity], [Half Day / Full Day], [Teacher Release (Y/N)], [Centre No], [Request Receipt Id], [Request Date], [Requested By], [Business Unit]) " & _
      "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"

      Dim sh As Worksheet
        Set sh = ThisWorkbook.Worksheets("Project_Name")
        'if sheet "Project_Name" exists in ThisWorkbook at compile time, just refer to it by its CodeName;
        'define its (Name) property (F4) and use that identifier to refer to that sheet anywhere in code.
        'e.g. if (Name) is "ProjectSheet", then you can do 'ProjectSheet.Cells(i, 2).Value'.

        For i = 7 To LastRow
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = Conn
    cmd.CommandType = adCmdText
    cmd.CommandText = sql

    cmd.Parameters.Append cmd.CreateParameter("AA Number", adVarChar, sh.Cells(i, 2).Value)
    cmd.Parameters.Append cmd.CreateParameter("aaname", adVarChar, sh.Cells(i, 3).Value)
    cmd.Parameters.Append cmd.CreateParameter("aarole", adVarChar, sh.Cells(i, 4).Value)
    cmd.Parameters.Append cmd.CreateParameter("projectname", adVarChar, sh.Cells(i, 5).Value)
    cmd.Parameters.Append cmd.CreateParameter("series", adVarChar, sh.Cells(i, 6).Value)
    cmd.Parameters.Append cmd.CreateParameter("paperno", adVarChar, sh.Cells(i, 7).Value)
    cmd.Parameters.Append cmd.CreateParameter("taskname", adVarChar, sh.Cells(i, 8).Value)
    cmd.Parameters.Append cmd.CreateParameter("amount", adVarChar, sh.Cells(i, 9).Value)
    cmd.Parameters.Append cmd.CreateParameter("paymentjustification", adVarChar, sh.Cells(i, 10).Value)
    cmd.Parameters.Append cmd.CreateParameter("paymentidentifier", adVarChar, sh.Cells(i, 12).Value)
    cmd.Parameters.Append cmd.CreateParameter("dateofactivity", adVarChar, sh.Cells(i, 13).Value)
    cmd.Parameters.Append cmd.CreateParameter("halfday/fullday", adVarChar, sh.Cells(i, 14).Value)
    cmd.Parameters.Append cmd.CreateParameter("teacherrelease(y/n)", adVarChar, sh.Cells(i, 15).Value)
    cmd.Parameters.Append cmd.CreateParameter("centreno", adVarChar, sh.Cells(i, 16).Value)
    cmd.Parameters.Append cmd.CreateParameter("receiptid", adVarChar, Sheets("Admin").Cells(i, 22).Value)
    cmd.Parameters.Append cmd.CreateParameter("requestdate", adVarChar, Format(Now(), "yyyy-MM-dd hh:mm:ss"))
    cmd.Parameters.Append cmd.CreateParameter("requestedby", adVarChar, Application.UserName)
    cmd.Parameters.Append cmd.CreateParameter("businessunit", adVarChar, Sheets("Admin").Cells(i, 20).Value)

    cmd.Execute
Next
Conn.CommitTrans

CleanExit:
    Conn.Close
    Exit Sub

CleanFail:
    Conn.RollbackTrans
    MsgBox "Something went wrong, transaction was rolled back."
    Debug.Print err.Number, err.Description
    Resume CleanExit
End Sub

我收到以下错误：

3708         Parameter object is improperly defined. Inconsistent or incomplete information was provided.

Answer 1

设置并打开您的连接：

Set conn = New ADODB.Connection
conn.ConnectionString = "connection string"
conn.Open

现在开始事务，并设置错误处理：

On Error GoTo CleanFail
conn.BeginTrans

不要将您的值连接到sql字符串中。相反，设置?占位符，现在您不需要关心单引号：

Dim sql As String
sql = "INSERT INTO [dbo].[TEP_Payments_Table] ([AA Number], [AA Name], [AA Role], [Project Name], [Series], [Paper No], [Task Name], [Amount], [Payment Justification], [Payment Identifier], [Date of Activity], [Half Day / Full Day], [Teacher Release (Y/N)], [Centre No], [Request Receipt Id], [Request Date], [Requested By], [Business Unit]) " & _
      "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"

现在开始循环。设置命令、创建和Append参数：

Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Project_Name")
'if sheet "Project_Name" exists in ThisWorkbook at compile time, just refer to it by its CodeName;
'define its (Name) property (F4) and use that identifier to refer to that sheet anywhere in code.
'e.g. if (Name) is "ProjectSheet", then you can do 'ProjectSheet.Cells(i, 2).Value'.

For i = 7 To LastRow
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = conn
    cmd.CommandType = adCmdText
    cmd.CommandText = sql

    cmd.Parameters.Append cmd.CreateParameter("aanumber", adVarChar, sh.Cells(i, 2).Value)
    cmd.Parameters.Append cmd.CreateParameter("aaname", adVarChar, sh.Cells(i, 3).Value)
    '...

一旦所有参数都以相同的顺序附加，占位符就会出现在命令文本 / 中sql，继续执行命令：

    cmd.Execute
Next

循环完成后，提交事务：

conn.CommitTrans

现在清理完毕，“快乐之路”就完成了：

CleanExit:
    conn.Close
    Exit Sub

如果出现任何问题，您需要在此处进行处理：

CleanFail:
    conn.RollbackTrans
    MsgBox "Something went wrong, transaction was rolled back."
    Debug.Print Err.Number, Err.Description
    Resume CleanExit
End Sub

此清理和错误处理代码对事务和连接状态做出了许多假设；最好在尝试关闭连接之前验证连接是否打开，以及是否有事务需要回滚。但你明白了。