【发布时间】：2020-04-18 14:06:20
【问题描述】：
更新问题： 我有更新表，此表包含与访问数据库 ID 匹配的唯一 ID，我正在尝试使用“更新”表中的 excel 值更新字段。 ID 在 A 列中，其余字段从 B 列存储到 R。我正在尝试实现以下目标，如下所示：
- 如果 A 列 (ID) 与现有 Access 数据库 ID 匹配，则更新记录（从 B 列到 R 的值）。然后在 S 列“更新”中添加文本
- 如果 A 列 (ID) 在现有 Access 数据库 ID 中未找到任何匹配项，则在 S 列中添加文本“ID NOT FOUND”
- 循环到下一个值
到目前为止，我有下面的 Sub for Update 和 Function for Existing ID (Import_Update Module)，但我收到了这个错误。
Sub Update_DB()
Dim dbPath As String
Dim lastRow As Long
Dim exportedRowCnt As Long
Dim NotexportedRowCnt As Long
Dim qry As String
Dim ID As String
'add error handling
On Error GoTo exitSub
'Check for data
If Worksheets("Update").Range("A2").Value = "" Then
MsgBox "Add the data that you want to send to MS Access"
Exit Sub
End If
'Variables for file path
dbPath = Worksheets("Home").Range("P4").Value '"W:\Edward\_Connection\Database.accdb" '##> This was wrong before pointing to I3
If Not FileExists(dbPath) Then
MsgBox "The Database file doesn't exist! Kindly correct first"
Exit Sub
End If
'find las last row of data
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim cnx As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
On Error GoTo errHandler
'Initialise the collection class variable
Set cnx = New ADODB.Connection
'Connection class is equipped with a —method— named Open
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'##> ID and SQL Query
ID = Range("A" & lastRow).Value
qry = "SELECT * FROM f_SD WHERE ID = '" & ID & "'"
'ConnectionString Open '—-5 aguments—-
rst.Open qry, ActiveConnection:=cnx, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'add the values to it
'Wait Cursor
Application.Cursor = xlWait
'Pause Screen Update
Application.ScreenUpdating = False
'##> Set exportedRowCnt to 0 first
UpdatedRowCnt = 0
IDnotFoundRowCnt = 0
If rst.EOF And rst.BOF Then
'Close the recordet and the connection.
rst.Close
cnx.Close
'clear memory
Set rst = Nothing
Set cnx = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
For nRow = 2 To lastRow
'##> Check if the Row has already been imported?
'##> Let's suppose Data is on Column B to R.
'If it is then continue update records
If IdExists(cnx, Range("A" & nRow).Value) Then
With rst
For nCol = 1 To 18
rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value 'Using the Excel Sheet Column Heading
Next nCol
Range("S" & nRow).Value2 = "Updated"
UpdatedRowCnt = UpdatedRowCnt + 1
rst.Update
End With
Else
'##>Update the Status on Column S when ID NOT FOUND
Range("S" & nRow).Value2 = "ID NOT FOUND"
'Increment exportedRowCnt
IDnotFoundRowCnt = IDnotFoundRowCnt + 1
End If
Next nRow
'close the recordset
rst.Close
' Close the connection
cnx.Close
'clear memory
Set rst = Nothing
Set cnx = Nothing
If UpdatedRowCnt > 0 Or IDnotFoundRowCnt > 0 Then
'communicate with the user
MsgBox UpdatedRowCnt & " Drawing(s) Updated " & vbCrLf & _
IDnotFoundRowCnt & " Drawing(s) IDs Not Found"
End If
'Update the sheet
Application.ScreenUpdating = True
exitSub:
'Restore Default Cursor
Application.Cursor = xlDefault
'Update the sheet
Application.ScreenUpdating = True
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnx = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Update_DB"
Resume exitSub
End Sub
检查ID是否存在的功能
Function IdExists(cnx As ADODB.Connection, sId As String) As Boolean
'Set IdExists as False and change to true if the ID exists already
IdExists = False
'Change the Error handler now
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim cmd As ADODB.Command 'dim the ADO command class
On Error GoTo errHandler
'Sql For search
Dim sSql As String
sSql = "SELECT Count(PhoneList.ID) AS IDCnt FROM PhoneList WHERE (PhoneList.ID='" & sId & "')"
'Execute command and collect it into a Recordset
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnx
cmd.CommandText = sSql
'ADO library is equipped with a class named Recordset
Set rst = cmd.Execute 'New ADODB.Recordset 'assign memory to the recordset
'Read First RST
rst.MoveFirst
'If rst returns a value then ID already exists
If rst.Fields(0) > 0 Then
IdExists = True
End If
'close the recordset
rst.Close
'clear memory
Set rst = Nothing
exitFunction:
Exit Function
errHandler:
'clear memory
Set rst = Nothing
MsgBox "Error " & Err.Number & " :" & Err.Description
End Function
【问题讨论】：
-
问题/问题是？
-
问题请edit，请勿在cmets中发布实际问题
-
@Mielew，您能否再次解释一下您在问题中遇到的问题和挑战？我们不明白这个问题请
-
嗨@Tsiriniaina Rakotonirina，我想更新AccessDB 中的现有记录，我有导出表循环到整个行并在accessDB 中添加信息。我有包含要附加到现有记录的新数据的更新表，只要提供的 ID 正确，则应在 AccessDB 中为相同 ID 更新数据，并在最后一列“已更新”中有确认文本或者如果在现有记录“ID NOT FOUND”中找不到匹配的 ID 链接：(hbkcrccjv-my.sharepoint.com/:f:/p/edward/…)
-
@Mielkew，我正在打开文件，但我不明白你的意图。您能解释一下更新表的用途吗？