Vba 存储旧值,然后在值更改时发送电子邮件
我最初发布了一个关于在单元格中的值发生变化时发送电子邮件的问题,这个问题已经解决,但这篇文章着眼于存储旧值,因此我创建了一篇新文章,因为这是一个新问题 我的目标是将一个单元格中的旧值存储在一个单元格范围内,然后根据另一个单元格中的名称,如果该单元格的旧值在该范围内,则会发送一封电子邮件,说明该值已更改 下面是我根据本论坛的其他帖子设置的代码,并根据我的需要进行了调整,当然它不起作用,所以我请求更多的指导和帮助Vba 存储旧值,然后在值更改时发送电子邮件,vba,excel,excel-2013,Vba,Excel,Excel 2013,我最初发布了一个关于在单元格中的值发生变化时发送电子邮件的问题,这个问题已经解决,但这篇文章着眼于存储旧值,因此我创建了一篇新文章,因为这是一个新问题 我的目标是将一个单元格中的旧值存储在一个单元格范围内,然后根据另一个单元格中的名称,如果该单元格的旧值在该范围内,则会发送一封电子邮件,说明该值已更改 下面是我根据本论坛的其他帖子设置的代码,并根据我的需要进行了调整,当然它不起作用,所以我请求更多的指导和帮助 第一个IF查看名称是否已更改以及是否已更改 发送电子邮件 第二部分查看C列中的人员姓名
IF
查看名称是否已更改以及是否已更改
发送电子邮件Dim-laTargetVal
Dim clsDateTargetval
私有子工作表_更改(ByVal目标作为范围)
调暗RgSel作为范围,RgCell作为范围
调暗lAmountCell作为范围,lAmountSel作为范围
Dim OutlookApp作为对象,MItem作为对象
Dim SUB为字符串,EmailAddr为字符串,收件人为字符串
Dim CustName为字符串,TitleCo为字符串,ClsDate为字符串,ContractPrice为字符串,lAmount为字符串,Product为字符串,Msg为字符串,pEmail为字符串
Application.ScreenUpdating=False
Application.DisplayAlerts=False
设置RgCell=范围(“C2:C100”)
设置RgSel=Intersect(目标,RgCell)
设置lAmountCell=范围(“O:O”)
出错时继续下一步
如果不是,那么RgSel什么都不是
设置OutlookApp=CreateObject(“Outlook.Application”)
对于RgSel中的每个单元格
如果cell.Value=“Zack”,则
如果是laTargetVal目标,那么
设置MItem=OutlookApp.CreateItem(0)
pEmail=“[电子邮件地址]”
CustName=cell.Offset(0,-1).Value
lAmount=格式(单元格偏移量(0,12).值,“货币”)
ClsDate=单元格偏移量(0,5).Value
合同价格=格式(单元格偏移量(0,10).值,“货币”)
乘积=单元格偏移量(0,13).值
TitleCo=单元偏移量(0,1).值
subc=“***贷款条款已更改***”和“-”以及UCase(客户名称)
收件人=“扎克”
EmailAddr=pEmail
“撰写消息
Msg=“Hi”&Recipient&“,”&vbCrLf&vbCrLf
Msg=Msg&“以下贷款参数已更改为”&CustName&vbCrLf&vbCrLf
Msg=Msg&“产品:&&Product&vbCrLf
Msg=Msg&“贷款金额从:”&laTargetVal&“更改为”&lAmount&vbCrLf
Msg=Msg&“截止日期:”&ClsDate&vbCrLf
Msg=Msg&“标题公司:”&TitleCo&vbCrLf
Msg=Msg和“合同价格:”&ContractPrice&vbCrLf&vbCrLf
Msg=Msg&“请查看L:驱动器中客户文件夹中的信息。”&vbCrLf&vbCrLf
Msg=Msg&“老板”&vbCrLf
Msg=Msg和“副总裁”
'创建邮件项目并发送
含螨
.To=EmailAddr
主语,主语
.Body=Msg
.发送
以
如果结束
如果结束
下一个细胞
如果结束
Application.DisplayAlerts=True
Application.ScreenUpdating=True
端接头
专用子工作表\u选择更改(ByVal目标作为范围)
调暗lAmountCell作为范围,lAmountSel作为范围
调暗clsDateCell作为范围,clsDateSel作为范围
设置lAmountCell=范围(“O:O”)
设置lAmountSel=相交(目标,lAmountCell)
设置clsDateCell=范围(“H:H”)
设置clsDateSel=Intersect(目标,clsDateCell)
如果不是拉蒙塞尔,那就什么都不是了
laTargetVal=格式(目标,“货币”)
如果结束
如果不是,那么clsDateSel什么都不是
clsDateTargetval=目标
如果结束
端接头
下次继续隐藏时出现的错误是什么?把它注释掉,看看是否还有其他bug需要处理,你的具体问题是什么?我注释掉了错误恢复下一步的,没有出现错误,但我确实注意到,在IF
上,当O列中的单元格发生更改时,它会发送电子邮件,只有在C列中的名称也发生更改时,它才起作用。你能去掉大量这类代码,将其减少到足以重现问题的程度吗?我的问题是:有没有更干净的方法来编写代码来存储O列中单元格的旧值,当它发生变化时,根据coluumn C中的名称发送一封包含旧值和新值的电子邮件。
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