如何在 Excel 导出中包含验证以访问（VBA 代码）

Question

如果可能的话，我想知道在将数据从 Excel 导出到 MS Access 中的表/数据库时如何实现某种验证。

这是我正在使用的代码：

Const TARGET_DB = "ProductsDB.accdb"

Sub PushTableToAccess()
Dim cnn As New ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim i As Long, j As Long
Dim Rw As Long

Sheets("bd").Activate
Rw = Range("A65536").End(xlUp).Row

Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB

With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
End With

Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="CLNTITPUB", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable

For i = 2 To Rw
rst.AddNew
For j = 1 To 19
rst(Cells(1, j).Value) = Cells(i, j).Value
Next j
rst.Update
Next i

rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing

End Sub

数据库表：

id_cot	名字
1	彼得
2	约翰

我想在VBA代码中包含的是导出数据之前的验证，它将检查列中是否有填充特定值的行，例如：

在表格的第一行中，“id_cot”列填充“1”。我希望代码提示一个“点击框”来询问用户是否要继续，因为已经有一个具有相同编号的“id_cot”。

谢谢

Answer 1

嘿，

您可以尝试下面的代码，首先，让我们添加一个存储 id_Cot 值的变量，然后我们在数据库中搜索它，一旦找到，我们会要求用户继续。

Dim strId_CotValue As String

For i = 2 To Rw
    
    For j = 1 To 19
    
    'Get the value of your ID.
    strId_CotValue = Cells(i, j).Value
    
        If IsIdUnique(strId_CotValue) = True Then
            If vbYes = MsgBox("Id already exists, continue ?", vbYesNo) Then
                rst.AddNew
                rst(Cells(1, j).Value) = Cells(i, j).Value
                rst.Update
            End If
        End If
        
    Next j
    
Next i

您可以使用此函数检查 id 是否唯一，它将根据给定的参数返回 true 或 false。不要忘记更改表和变量的名称。 :

Public Function IsIdUnique(ByVal strIdValue As String) As Boolean

Dim blnIsIdUnique As Boolean
    '
blnIsIdUnique = Nz(DLookup("Id", "tblTest", "Id = " & CLng(strIdValue)), False)
    '
IsIdUnique = blnIsIdUnique
    
End Function

这就是你所追求的吗？