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