如何在表单Estimated Close Date字段变更时触发邮件通知代码

需求说明 #

• 表单包含「估计结束日期（Estimated Close Date）」字段，对应代码中的TextBox13（绑定数据库字段EstClosedDate）
• 当该字段值修改并执行更新操作时，自动向指定用户发送邮件
• 邮件需包含该字段的旧值与新值

实现步骤 #

1. 保存旧日期值 #

在表单模块顶部添加模块级变量，用于存储加载记录时的旧日期：

' 模块级变量，存储旧的估计结束日期
Private oldEstClosedDate As String

修改ListBox1_DblClick事件，加载记录时将旧日期存入变量：

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.ListBox1.ListIndex >= 0 Then
        Me.TextBox6.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
        Me.TextBox1.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2)
        Me.ComboBox2.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3)
        Me.TextBox9.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 4)
        Me.TextBox7.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 5)
        Me.TextBox8.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 6)
        Me.TextBox11.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 19)
        Me.TextBox12.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 20)
        ' 保存旧的估计结束日期到模块变量
        oldEstClosedDate = Me.ListBox1.List(Me.ListBox1.ListIndex, 21)
        Me.TextBox13.value = oldEstClosedDate
        Me.TextBox14.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 18)
        Me.major.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 69)
        Me.loanPurpose.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 68)
        Me.Collateral.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 110)
        Me.PropType.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 111)
        Me.Address.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 112)
        Me.Underwriter.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 70)
        Me.NewMoneyAmount.value = Me.ListBox1.List(Me.ListBox1.ListIndex, 71)
    End If
End Sub

2. 在更新操作中判断日期变更并发送邮件 #

修改CommandButton2_Click事件，执行更新后对比新旧日期，若不同则触发邮件：

Private Sub CommandButton2_Click()
    If Me.TextBox1.value = "" Or Me.ComboBox2.value = "" Then
        MsgBox "借款人和贷款专员字段为必填项"
        Exit Sub
    Else
        ' 获取新的估计结束日期
        Dim newEstClosedDate As String
        newEstClosedDate = Me.TextBox13.value
        
        ' 执行更新SQL语句
        sql_query = "UPDATE [dbo].[C&IPipeline] " & _
            " SET [BorrowerName] = '" & Me.TextBox1.value & "'," & _
            "  [PotCustFormUser] ='" & Me.TextBox10.value & "  ', " & _
            " [Underwriter]  = '" & Me.Underwriter.value & "'," & _
            " [NewMoneyAmount]  = '" & Me.NewMoneyAmount.value & "'," & _
            "  [LoanOfficer] ='" & Me.ComboBox2.value & "  ', " & _
            " [LoanNumber] = '" & Me.TextBox7.value & "', " & _
            " [Comments] = '" & Me.TextBox8.value & " ', " & _
            " [LoanAmount] = '" & Me.TextBox11.value & " ', " & _
            " [InterestRate] = '" & Me.TextBox12.value & " ', " & _
            " [EstClosedDate] = '" & newEstClosedDate & " ', " & _
            " [CommercialRM] = '" & Me.TextBox14.value & " ', " & _
            " [LoanPurpose] = '" & Me.loanPurpose.value & " ', " & _
            " [Collateral] = '" & Me.Collateral.value & " ', " & _
            " [PropertyType] = '" & Me.PropType.value & " ', " & _
            " [CollateralPropertyAddress] = '" & Me.Address.value & " ', " & _
            " [LoanType] = '" & Me.major.value & " ', " & _
            " [ApplicationCompleteDate] = '" & Me.TextBox9.value & " ' " & _
            " WHERE AutoID=  " & Me.TextBox6.value

        Call Execute_SQL_query(sql_query)
        Call clear_Text
        
        ' 判断日期是否变更，变更则发送通知邮件
        If oldEstClosedDate <> newEstClosedDate Then
            Dim outlookapp As Object
            Dim outlookmailitem As Object
            Set outlookapp = CreateObject("Outlook.Application")
            Set outlookmailitem = outlookapp.createitem(0)

            ' 设置邮件收件人等信息
            outlookmailitem.To = "指定用户邮箱@xxx.com" ' 替换为实际收件人邮箱
            outlookmailitem.cc = ""
            outlookmailitem.bcc = ""
            outlookmailitem.Subject = "估计结束日期已变更 - " & Me.TextBox1.value & " (" & Me.TextBox7.value & ")"
            outlookmailitem.Body = "借款人名: " & Me.TextBox1.value & vbCrLf & _
                                  "贷款编号: " & Me.TextBox7.value & vbCrLf & vbCrLf & _
                                  "旧的估计结束日期: " & oldEstClosedDate & vbCrLf & _
                                  "新的估计结束日期: " & newEstClosedDate & vbCrLf & vbCrLf & _
                                  "请知悉此变更。"
            outlookmailitem.display ' 若要直接发送，改为outlookmailitem.Send
            Set outlookapp = Nothing
            Set outlookmailitem = Nothing
        End If
    End If

    ' 注：原代码末尾的INSERT语句用于新增记录，若此按钮仅用于更新操作，建议移除该段代码
    sql_query = " INSERT INTO [dbo].[C&IPipeline] ([PotCustFormUser],[BorrowerName] ,[LoanOfficer]  ,[ApplicationCompleteDate] ,[LoanNumber] ,[Comments],[Denied],[Withdrawn],[Incomplete],[Counteroffer],[InitAssessment],[InitialFileReviewUW],[NeedInfoFromRM],[ConceptMemoPckg],[ApproveConceptMemoPckg],[TermSheet],[CustReviewTermSheet],[PrepareCCR],[ReviewCCR],[CreditApproval],[SubmittoDocs],[Funding],[BookingComp],[CreditApprovalNA],DocsComplete,[LoanAmount],[InterestRate],[EstClosedDate],[CommercialRM],[LoanType],[LoanPurpose],[UWConfInfoRec],[Collateral],[PropertyType],[CollateralPropertyAddress],[Underwriter],[NewMoneyAmount])" & _
                " Values ('" & Me.TextBox10.value & "' ,'" & Me.TextBox1.value & "' ,'" & Me.ComboBox2.value & "' ,'" & Me.TextBox9.value & "','" & Me.TextBox7.value & "','" & Me.TextBox8.value & "',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,'" & Me.TextBox11.value & "','" & Me.TextBox12.value & "','" & Me.TextBox13.value & "','" & Me.TextBox14.value & "','" & Me.loanPurpose.value & "','" & Me.major.value & "',0,'" & Me.Collateral.value & "','" & Me.PropType.value & "','" & Me.Address.value & "','" & Me.Underwriter.value & "','" & Me.NewMoneyAmount.value & "')"
End Sub

3. 注意事项 #

• 替换代码中的"指定用户邮箱@xxx.com"为实际需要通知的用户邮箱
• 若要自动发送邮件而非弹出编辑窗口，将outlookmailitem.display改为outlookmailitem.Send
• 确保Outlook已正确配置，且允许VBA访问（可在Outlook信任中心设置允许宏）
• 若此按钮仅用于更新现有记录，建议移除代码末尾的INSERT语句，避免重复新增数据

内容的提问来源于stack exchange，提问作者Power5