如何使用 WHERE 条件从 Excel 工作表中插入字段以访问数据库

Question

我一直在为这个问题苦恼一段时间，我想知道是否有解决方案！

所以我有一个名为 R1 的表，在 Access 中有两个列：[Department] 和 [DepartmentQV]，[Department] 列有一些带有值的字段，但 [DepartmentQV] 列是空白的

我还有一个 Excel 电子表格，它还有一个 [Department] 列和一个 [DepartmentQV] 列。 [Department] 列与 Access 中的列相同，但 [DepartmentQV] 列具有值。

我要做的就是使用 ADODB 和 SQL 将 Excel 工作表中的 [DepartmentQV] 值拉入到 [Department] 值匹配的 Access 数据库中。

不幸的是，这根本不起作用，我不断收到相同的错误“没有为一个或多个必需参数提供值”，我完全感到困惑。任何帮助，将不胜感激！感谢您抽出宝贵时间阅读本文！

最好， 库尔特

这是我目前的代码！

 lastRow = ActiveWorkbook.ActiveSheet.Range("B" & ActiveWorkbook.ActiveSheet.Rows.Count).End(xlUp).Row

  Set cn = CreateObject("ADODB.Connection")
  dbPath = glob_sdbPath
  dbWb = Application.ActiveWorkbook.FullName
  dbWs = ActiveWorkbook.ActiveSheet.Name
  scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
  dsh = "[" & Application.ActiveSheet.Name & "$B2:C" & lastRow & "]"
  cn.Open scn

  sSql = "INSERT INTO  R1([Department_QV])"
  sSql = sSql & " SELECT [Spoilage] FROM [Excel 12.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh & "    WHERE " & dsh  & ".[Department] = R1.[Department]"

  cn.Execute sSql

Answer 1

这里的问题是使用 ADO 在 Access 和 Excel 之间进行更新。当我尝试将派生的 Excel 表与 Access 表进行 INNER JOIN 并执行更新时，我收到了错误：

"Run-time error '-2147467259 (80004005)':
You cannot edit this field because it resides in a linked Excel spreadsheet. The ability to edit data in a linked Excel spreadsheet has been disabled in this Access Release."

没关系，Access 表没有链接到 Excel，我找不到解决方案。我决定将 Excel 数据推送到 Access 中的临时表中，并针对 R1 和临时表运行更新。执行更新的另一种方法是打开两个记录集，一个是 Excel 表，另一个是 Access 表，然后搜索一个并更新，但我选择不这样做。

（我引用了 Microsoft ActiveX Data Objects 2.8 Library 和 Microsoft ADOX Ext. 2.8 for DDL And Security，所以我有智能感知。您可以根据需要实例化对象。）：

Public Sub ExcelToAcessUpdate()
On Error GoTo ErrorHandler

    Dim cn As New ADODB.Connection
    Dim rstTables As New ADODB.Recordset
    Dim cat As New ADOX.Catalog

    Dim dbWb As String
    Dim dbWs As String
    Dim dsh As Variant
    Dim lastRow As Integer

    Dim dbPath As String
    Dim scn As String
    Dim sTempTable As String
    Dim sSql As String

    dbWb = Application.ActiveWorkbook.FullName
    dbWs = ActiveWorkbook.ActiveSheet.Name
    dsh = "[" & Application.ActiveSheet.Name & "$B2:C" & lastRow & "]"
    lastRow = ActiveWorkbook.ActiveSheet.Range("B" & ActiveWorkbook.ActiveSheet.Rows.Count).End(xlUp).Row

    dbPath = glob_sdbPath
    scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

    'This is the name of the temp table in Access
    'we will use to hold our Excel data.
    sTempTable = "tblMyExcelTemp"

    cn.Open scn

    'Make the ADO connection get a recordset of tables in database.
    Set rstTables = cn.OpenSchema(adSchemaTables)

    'If temp table we want to use already exists in db, delete it.
    With rstTables
        Do Until .EOF
            If .Fields("TABLE_TYPE") = "TABLE" And _
               .Fields("TABLE_NAME") = sTempTable Then
                    Set cat.ActiveConnection = cn
                    cat.Tables.Delete sTempTable

                    Exit Do
            End If

            .MoveNext
        Loop
    End With

    'Get all our Excel data and push it into temp table.
    sSql = "SELECT [Department], [Spoilage] INTO " & sTempTable & " " & _
           "FROM [Excel 12.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh

    cn.Execute sSql

    'Update R1 using inner join against Excel Temp table.
    sSql = "UPDATE R1 INNER JOIN " & sTempTable & " e ON R1.[Department] = e.[Department] " & _
           " SET Department_QV = e.[Spoilage]"

    cn.Execute sSql

ExitMe:
    If cn Is Nothing = False Then
        If cn.State <> adStateClosed Then
            cn.Close
        End If
    End If

    Set cat = Nothing
    Set rstTables = Nothing
    Set cn = Nothing

    Exit Sub
ErrorHandler:
    'Lazy error handling, need to go through cn.Errors collection, actually.
    MsgBox Err.Number & ": " & Err.Description
    GoTo ExitMe

End Sub

我不是临时表解决方案的忠实拥护者，但它确实有效，如果您经常需要做这种事情，它可以成为您的范例。希望它对你有用。使用记录集的基于游标的解决方案效率太低了，但我想也可以这样做。