通过记录访问 VBA

Question

我有一个子表单中的姓名列表，在我的主表单上我有一个按钮，允许用户查看给定联系人的“个人资料”。一旦进入个人资料，我希望有一个按钮，允许用户通过单击“下一个用户”移动到子表单中的下一个名称（同时保持“个人资料”视图）。

此外，数据库会询问用户她/他是否想在移动到下一个用户的配置文件之前将更改 (vbYesNo) 保存到配置文件。出于某种原因，我的代码在用户第一次单击“下一个联系人”和“是”时起作用，但是每次用户单击“下一个联系人”和“是”时，它都不会滚动到下一个联系人。请注意，如果用户在不想保存对配置文件所做的更改时选择“否”，则“下一个用户”按钮可以正常工作。

代码如下：

Private Sub Command65_Click()

Dim strFirstName As String
Dim strLastName As String
Dim strIndustry As String
Dim strCountry As String
Dim strState As String
Dim strCity As String
Dim strCompany As String
Dim strTitle As String
Dim strStatus As String
Dim strPhone As String
Dim strEmail As String
Dim strOwner As String
Dim DateNow As String
Dim rs As DAO.Recordset

'Allow user to leave some fields blank. User must fill in certain fields.

Dim VisEnable

intMsg = MsgBox("Would you like to save the current contact's information?", vbYesNo)

If intMsg = 6 Then

If IsNull(Me.txtFirstName) Then
    MsgBox ("Please add First Name for this Prospect")
    Me.txtFirstName.SetFocus
    Exit Sub
End If

If IsNull(Me.txtLastName) Then
    MsgBox ("Please add Last Name for this Prospect")
    Me.txtLastName.SetFocus
    Exit Sub
End If

If IsNull(Me.cboIndustry) Then
    Me.cboIndustry = ""
    Exit Sub
End If

If IsNull(Me.cboGeo) Then
    Me.cboGeo = ""
End If

If IsNull(Me.cboInfluence) Then
    Me.cboInfluence = ""
End If

If IsNull(Me.cboSchool) Then
    Me.cboSchool = ""
End If
If IsNull(Me.cboTier) Then
    Me.cboTier = ""
End If
If IsNull(Me.cboCompany) Then
    Me.cboCompany = ""
End If

If IsNull(Me.txtTitle) Then
    Me.txtTitle = ""
End If

If IsNull(Me.cboStatus) Then
    Me.cboStatus = ""
    Exit Sub
End If

If IsNull(Me.cboOwner) Then
    Me.cboOwner = ""
End If

If IsNull(Me.txtPhone) Then
    Me.txtPhone = ""
End If

If IsNull(Me.txtEmail) Then
    MsgBox ("Please add Email for this Prospect")
    Me.txtEmail.SetFocus
    Exit Sub
End If

If IsNull(Me.txtNotes) Then
    Me.txtNotes = ""
    Exit Sub
End If

If IsNull(Me.txtInitialProspectEmailSentDate) Then
Me.txtInitialProspectEmailSentDate = ""
End If

If IsNull(Me.txtNextTouchPoint) Then
Me.txtNextTouchPoint = ""
End If

strFirstName = Me.txtFirstName
strLastName = Me.txtLastName
strIndustry = Me.cboIndustry
strCompany = Me.cboCompany
strTitle = Me.txtTitle
strStatus = Me.cboStatus
strPhone = Me.txtPhone
strEmail = Me.txtEmail
strNotes = Me.txtNotes
strOwner = Me.cboOwner
dtEmailSent = Me.txtInitialProspectEmailSentDate
dtNextTouchPoint = Me.txtNextTouchPoint
strRegion = Me.cboGeo
strSoR = Me.cboTier
strInfluence = Me.cboInfluence
strClient = Me.ckClient
strCoworker = Me.ckCoworker
strSchool = Me.cboSchool

strSQL = "Update tblProspect Set FirstName = " & """" & strFirstName & """" & ",LastName = " & """" & strLastName & """" & ",Industry = " & """" & strIndustry & """" & "" & _
",Geography = " & """" & strRegion & """" & ",StrengthofRelationship = " & """" & strSoR & """" & ",School = " & """" & strSchool & """" & ",Company = " & """" & strCompany & """" & "" & _
",Title = " & """" & strTitle & """" & ",Status = " & """" & strStatus & """" & ", InfluenceLevel = " & """" & strInfluence & """" & ", FormerClient = " & strClient & ", FormerCoWorker = " & strCoworker & "" & _
",Email = " & """" & strEmail & """" & ",Phone = " & """" & strPhone & """" & ",ProspectOwner = " & """" & strOwner & """" & ",Notes = " & """" & strNotes & """" & ""


If dtNextTouchPoint <> "" Then
strSQL = strSQL & " ,NextTouchPoint = #" & dtNextTouchPoint & "#"
End If

If dtEmailSent <> "" Then
strSQL = strSQL & " ,LastEmailDate = #" & dtEmailSent & "#"
End If
strSQL = strSQL & " WHERE Email = " & """" & strEmail & """" & ""
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True


intRecord = Me.txtRecord + 1

    Set rs = CurrentDb.OpenRecordset("qselProspects")
    If rs.RecordCount <> 0 Then
    rs.MoveLast
    If intRecord = 1 Then
    intRecord = rs.RecordCount + 1
    End If
    End If

    If rs.RecordCount <> 0 Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True

    If intRecord = rs.AbsolutePosition Then

            Me.txtRecord = intRecord
            Me.txtFirstName = rs!FirstName
            Me.txtLastName = rs!LastName
            Me.txtTitle = rs!Title
            Me.cboCompany = rs!Company
            Me.cboIndustry = rs!Industry
            Me.cboGeo = rs!Geography
            Me.cboTier = rs!StrengthofRelationship
            Me.cboIndustry = rs!InfluenceLevel
            Me.cboSchool = rs!School
            Me.ckClient = rs!FormerClient
            Me.ckCoworker = rs!FormerCoWorker
            Me.cboStatus = rs!Status
            Me.cboOwner = rs!ProspectOwner
            Me.txtEmail = rs!Email
            Me.txtPhone = rs!Phone
            Me.txtNextTouchPoint = rs!NextTouchPoint
            Me.txtNotes = rs!Notes
            Me.txtInitialProspectEmailSentDate = rs!LastEmailDate

            End If
     rs.MoveNext
    Loop
End If

'''///If you choose No it works, but if you choose Yes it does not...very strange
Else

intRecord = Me.txtRecord + 1

    Set rs = CurrentDb.OpenRecordset("qselProspects")
    If rs.RecordCount <> 0 Then
    rs.MoveLast
    If rs.RecordCount = intRecord Then
    intRecord = 0
    End If
    End If

    If rs.RecordCount <> 0 Then
    rs.MoveFirst 
    Do Until rs.EOF = True

            If intRecord = rs.AbsolutePosition Then

            Me.txtRecord = intRecord
            Me.txtFirstName = rs!FirstName
            Me.txtLastName = rs!LastName
            Me.txtTitle = rs!Title
            Me.cboCompany = rs!Company
            Me.cboIndustry = rs!Industry
            Me.cboGeo = rs!Geography
            Me.cboTier = rs!StrengthofRelationship
            Me.cboIndustry = rs!InfluenceLevel
            Me.cboSchool = rs!School
            Me.ckClient = rs!FormerClient
            Me.ckCoworker = rs!FormerCoWorker
            Me.cboStatus = rs!Status
            Me.cboOwner = rs!ProspectOwner
            Me.txtEmail = rs!Email
            Me.txtPhone = rs!Phone
            Me.txtNextTouchPoint = rs!NextTouchPoint
            Me.txtNotes = rs!Notes
            Me.txtInitialProspectEmailSentDate = rs!LastEmailDate

            End If

     rs.MoveNext
    Loop

End If
End If
End Sub

感谢谁能解决这个问题！这已经吃掉了太多的时间。

Answer 1

这不是一个答案，但我在这里写它是因为它不适合评论。一些建议，如果你已经申请，就可以免除你所有的头痛。

1) 您的代码遵循模式

If User_Says_Yes Then
   Save
   Fetch_Next_Record
Else
   Fetch_Next_Record
Endif

这是有问题的，因为 Fetch_Next_Record 包含大量代码并且是重复的，并且您会花费大量时间来查看它的不同之处。复制代码通常是一个非常糟糕的主意。尝试使用以下模式重写它：

If User_Says_Yes Then
   Save
Endif
Fetch_Next_Record

2) 尽量缩短代码，尽可能多地移至私有子例程。例如，写一些像BuildSQL() as String这样的函数，像updateFormFromRs(rs as Recordset)这样的子程序。一般来说，当您的任何例程或函数变得太长时，例如超过 20 或 30 行，您应该考虑将一些代码迁移到子例程和函数中

3) 缩进你的代码。没有它就很难遵循你的代码..只是看看当用户说不时开始的 Else 在哪里......

4) 您获取记录集中的整个表，只是滚动它并找到一条要显示的与if intRecord = rs.AbsolutePosition 匹配的记录？为什么不使用带有WHERE 子句的SQL 语句并只加载所需的记录？这是您需要在任何具有大量数据的严肃应用程序中应用的东西。

5) 类似If rs.EOF = True Then 的语句：简单的If rs.EOF Then。 额外的= True 不会使测试更加严格。好像没有它，我们检查条件是否几乎为真。

最后，即使你可能从别人那里继承了这段代码，我相信你也必须彻底重写它并改进它，越快越好。是的，我相信如果您遵循这些准则，您将能够非常轻松地调试代码。

友好:)