插入查询以插入多行总是最终在表中插入少一行

时间:2013-12-19 16:18:25

标签: sql sql-server vba ms-access-2010

我有一个连续的子表单,其中包含一个复选框(IsTag)和一个联系人姓名。一个将记录插入表中的按钮。该按钮执行以下查询。 这是我对表单的插入查询:

CurrentDb.Execute ("INSERT INTO [dbo_PrimaryContacts/InternalContacts_IntersectionTable] SELECT '" & progID & "' As Program_ID ,tmpInternalContacts_ID As InternalContacts_ID FROM dbo_tmpInternalContacts WHERE IsTag = True;"), dbFailOnError

表[dbo_PrimaryContacts / InternalContacts_IntersectionTable]是一个链接表。

查询从主窗体中获取程序ID(progID)。 我的问题是:假设我选择了5个复选框并单击按钮,插入查询只插入4行。我试图在sql server中运行查询,它运行得很好,但是当它作为vba代码的一部分执行时,它会少插入一行。

我尝试添加一个新的Identity字段并使用dbSeeChanges,但它没有用。

任何人都可以帮我解决这个问题。

谢谢。

这是我的vba代码:

Private Sub Command15_Click()


Dim strSel As String
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim progID As String
progID = Forms![F_PROGRAM MAIN].Program_ID.Value
Debug.Print progID
Set dbs = CurrentDb
strSel = "Select Program_ID from [dbo_PrimaryContacts/InternalContacts_IntersectionTable];"
Set rs = dbs.OpenRecordset(strSel)

rs.FindFirst "Program_ID = '" & progID & "'"
If rs.NoMatch Then
DoEvents
  CurrentDb.Execute ("INSERT INTO [dbo_PrimaryContacts/InternalContacts_IntersectionTable] SELECT '" & progID & "' As Program_ID ,tmpInternalContacts_ID As InternalContacts_ID FROM dbo_tmpInternalContacts WHERE IsTag = True;"), dbFailOnError
DoEvents
  MsgBox "Tags have been saved successfully!", vbInformation, "MyApp"
  GoTo Cleanup
Else
   DoEvents
    CurrentDb.Execute ("DELETE FROM [dbo_PrimaryContacts/InternalContacts_IntersectionTable] WHERE Program_ID = '" & progID & "';"), dbFailOnError
    CurrentDb.Execute ("INSERT INTO [dbo_PrimaryContacts/InternalContacts_IntersectionTable] SELECT '" & progID & "' As Program_ID ,tmpInternalContacts_ID As InternalContacts_ID FROM dbo_tmpInternalContacts WHERE IsTag = True;"), dbFailOnError
   DoEvents
    MsgBox "Tags have been saved successfully!", vbInformation, "MyApp"

 End If
Me.Parent.Refresh
Cleanup:
rs.Close
Set rs = Nothing
Set dbs = Nothing
Dim result As String
Set rs = CurrentDb.OpenRecordset("Select [FullName] from dbo_tmpInternalContacts where IsTag = true;")
While rs.EOF = False
         result = result & ", " & rs.Fields("[FullName]")
    rs.MoveNext
Wend
 If Left(result, 2) = ", " Then result = Right(result, Len(result) - 2)
Me.Parent!txtPrimaryContact = result

Command15_Click_Exit:
Exit Sub

Command15_Click_Err:
MsgBox Error$
Resume Command15_Click_Exit

End Sub

0 个答案:

没有答案