Сохраните старое значение, затем отправьте электронное письмо, если значение изменится - PullRequest
0 голосов
/ 31 августа 2018

Первоначально я отправил вопрос об отправке электронного письма, если значение в ячейке изменилось, но это было решено, но в этом сообщении рассматривается сохранение старого значения, поэтому я создал новое сообщение, поскольку это новый вопрос.

Моя цель - сохранить старое значение из ячейки в диапазоне ячеек, а затем на основе имени в другой ячейке, если старое значение <> новое значение ячейки в этом диапазоне отправит электронное письмо с указанием значение изменилось.

Ниже приведен код, который я настроил на основе других сообщений, найденных на этом форуме и настроенных в соответствии с моими потребностями, конечно, он не работает, поэтому я прошу дополнительных указаний и помощи.

  1. Первый IF проверяет, было ли изменено имя и было ли оно отправляет электронное письмо.
  2. вторая часть рассматривает имя человека в столбце 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...