首页 > 解决方案 > 通过循环附加数据以从 excel vba 访问

问题描述

想知道你是否可以帮忙。我在 Excel 上填充了一个长度不确定的表格(它随着人们添加它而增长)。需要通过使用 Excel 中的按钮将这些无法确定的数据量添加到 Access 中的数据库中。我已经生成了以下代码来尝试缓解这种情况,但得到了

运行时错误“3709”:连接不能用于执行此操作。在这种情况下,它要么是关闭的,要么是无效的。

当我打开调试它指向这一行:

rs.Open sqlstr, DBCont

这可以在下面的代码中找到:

Sub submittoDB()
    Dim DBCont As Variant
    Set DBCont = CreateObject("ADODB.connection")
    Dim StrDBPath As String
    StrDBPath = "PATH Here\Database1.accdb"
    Dim sConn As String
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & StrDBPath & ";" & _
        "Jet OLEDB:Engine Type=5;" & _
        "Persist Security Info=False;"
    DBCont.Open sConn
    MsgBox "Open DB"
    Dim rs As Object
    Set rs = CreateObject("ADODB.Recordset")
    Dim sqlstr As String
    Dim endlimit As Integer
    Dim i As Integer
    endlimit = Cells(Rows.Count, "H").End(xlUp).Row + 1
    'need to loop each line and remove test
    For i = 5 To endlimit
        sqlstr = "INSERT INTO DigiFinTracker (ProjectNo, ProjectName, Client, Tool, SuggAct, PercSav,PreDigCost,SuggSave,PropSav) VALUES ('" & Cells(6, 4) & "', '" _
        & Cells(5, 4) & "', '" & Cells(4, 4) & "', '" & Cells(i, 8) & "', '" & Cells(i, 9) & "', '" & Cells(i, 10) _
        & "', '" & Cells(i, 11) & "', '" & Cells(i, 12) & "', '" & Cells(i, 13) & "')"
        rs.Open sqlstr, DBCont
        DBCont.Close
    Next i
    DBCont.Close
End Sub

抱歉,如果答案相当简单,或者我遗漏了一些重要的东西,我似乎无法理解出了什么问题以及是否可以循环这种类型的过程。

非常感谢您提前回复!

标签: excelvbaloopsms-accessadodb

解决方案


在循环中,您将在每次迭代时关闭连接 - DBCont.Close。因此它不适用于第二次迭代。

从循环中删除DBCont.Close(建议)或每次打开它并删除DBCont.Open sConn循环之前的:

For i = 5 To endlimit
    DBCont.Open sConn   'It would work better if you delete this line
    sqlstr = "INSERT INTO DigiFinTracker (ProjectNo, ProjectName, Client, Tool, SuggAct, PercSav,PreDigCost,SuggSave,PropSav) VALUES ('" & Cells(6, 4) & "', '" _
    & Cells(5, 4) & "', '" & Cells(4, 4) & "', '" & Cells(i, 8) & "', '" & Cells(i, 9) & "', '" & Cells(i, 10) _
    & "', '" & Cells(i, 11) & "', '" & Cells(i, 12) & "', '" & Cells(i, 13) & "')"
    rs.Open sqlstr, DBCont  
    DBCont.Close        'And delete this line as well
Next i

要查看导致数据不匹配的原因,请尝试以下操作:

sqlstr = "INSERT INTO DigiFinTracker (ProjectNo, ProjectName, Client, Tool, SuggAct, PercSav,PreDigCost,SuggSave,PropSav) VALUES ('" & Cells(6, 4) & "', '" _
& Cells(5, 4) & "', '" & Cells(4, 4) & "', '" & Cells(i, 8) & "', '" & Cells(i, 9) & "', '" & Cells(i, 10) _
& "', '" & Cells(i, 11) & "', '" & Cells(i, 12) & "', '" & Cells(i, 13) & "')"
 Debug.Print sqlstr
  • 查看即时窗口(Ctrl+G打开);
  • 从那里复制 SQL 语句;
  • 将其粘贴到 Access 中并一直工作,直到您没有从查询中获得某些结果;

推荐阅读