Question

我最初发布了一个有关在单元格中的值发生更改时发送电子邮件的问题，该问题已解决，但是这篇文章着眼于存储旧值，所以我创建了新帖子，因为这是一个新问题。

我的目标是存储一个单元格范围内某个单元格的旧值，然后根据另一个单元格中的名称，如果该范围内该单元格的旧值<>新值发送出去，说明价值已经改变。

下面是我根据在该论坛上找到的其他帖子建立的代码，并根据我的需要进行了调整，当然它不起作用，所以我需要更多指导和帮助。

第一个IF用于查看名称是否已更改以及是否已更改发送电子邮件。
第二部分查看C列中的人名，如果信息在O列的一个单元格中发生变化，它发出另一个电子邮件。

代码：

Dim laTargetVal
Dim clsDateTargetval

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RgSel As Range, RgCell As Range
    Dim lAmountCell As Range, lAmountSel As Range
    Dim OutlookApp As Object, MItem As Object
    Dim Subj As String, EmailAddr As String, Recipient As String
    Dim CustName As String, TitleCo As String, ClsDate As String, ContractPrice As String, lAmount As String, Product As String, Msg As String, pEmail As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set RgCell = Range("C2:C100")
    Set RgSel = Intersect(Target, RgCell)
    Set lAmountCell = Range("O:O")

    On Error Resume Next

    If Not RgSel Is Nothing Then
        Set OutlookApp = CreateObject("Outlook.Application")
        For Each cell In RgSel
            If cell.Value = "Zack" Then
                If laTargetVal <> Target Then
                    Set MItem = OutlookApp.CreateItem(0)
                    pEmail = "[email address]"
                    CustName = cell.Offset(0, -1).Value
                    lAmount = Format(cell.Offset(0, 12).Value, "Currency")
                    ClsDate = cell.Offset(0, 5).Value
                    ContractPrice = Format(cell.Offset(0, 10).Value, "Currency")
                    Product = cell.Offset(0, 13).Value
                    TitleCo = cell.Offset(0, 1).Value
                    Subj = "***LOAN TERMS CHANGED***" & " - " & UCase(CustName)
                    Recipient = "Zack"
                    EmailAddr = pEmail

                    '   Compose Message
                    Msg = "Hi " & Recipient & "," & vbCrLf & vbCrLf
                    Msg = Msg & "The following loan parameters have changed for " & CustName & vbCrLf & vbCrLf
                    Msg = Msg & "     Product:  " & Product & vbCrLf
                    Msg = Msg & "     Loan Amount changed from:  " & laTargetVal & " to " & lAmount & vbCrLf
                    Msg = Msg & "     Closing Date:  " & ClsDate & vbCrLf
                    Msg = Msg & "     Title Company:  " & TitleCo & vbCrLf
                    Msg = Msg & "     Contract Price:  " & ContractPrice & vbCrLf & vbCrLf
                    Msg = Msg & "Please review the information in their customer folder in the L: Drive." & vbCrLf & vbCrLf
                    Msg = Msg & "The Boss" & vbCrLf
                    Msg = Msg & "Vice President"

                    '   Create Mail Item and send
                    With MItem
                        .To = EmailAddr
                        .Subject = Subj
                        .Body = Msg
                        .Send
                    End With
                End If
            End If
        Next cell
    End If

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim lAmountCell As Range, lAmountSel As Range
    Dim clsDateCell As Range, clsDateSel As Range

    Set lAmountCell = Range("O:O")
    Set lAmountSel = Intersect(Target, lAmountCell)
    Set clsDateCell = Range("H:H")
    Set clsDateSel = Intersect(Target, clsDateCell)

    If Not lAmountSel Is Nothing Then
        laTargetVal = Format(Target, "Currency")
    End If
    If Not clsDateSel Is Nothing Then
        clsDateTargetval = Target
    End If

End Sub

存储旧值，如果值更改，则发送电子邮件

0 个答案: