每当填充单元格时，似乎会触发Excel电子邮件宏

Question

我有一个跟踪重要日期的Excel电子表格，如果您错过了该日期的发票，它会自动向相关人员发送一封电子邮件，提醒他们这样做。宏功能很好，并触发了触发器

`

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("2015").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1

If Range("Q" & r).Value = "Received" Then
        Call Macro1
    End If

If Range("K" & r).Value = "Overdue" Then
        Call email
    End If


Next r
End Sub

`

Sub email()
Dim OutApp As Object
Dim OutMail As Object
Dim FName As String


Sheets("2015").Activate

For i = 1 To 100
If Sheets("2015").Range("K" & i).Value = "Overdue" Then


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
With OutMail
.To = Sheets("2015").Range("S" & i).Value
.CC = ""
.Subject = Sheets("2015").Range("B" & i).Value
.Body = "You have missed a valuation date for this project!"

.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing


End If
Next i

End Sub

'

正如您所看到的，我是新手，所以我的大多数代码来自互联网上的不同示例。我遇到的问题是，当K列中的单元符合要求时，＃34;过期＆＃34;当任何其他单元格发生更改时，宏将重复向用户发送电子邮件。那就是K5 =＆＃34;过期＆＃34;然后我去A6进入新用户，A5的用户将再次通过电子邮件发送。对于所有单元格都会发生这种情况，直到我将单元格k5更改为＆＃34;发送＆＃34;。

我怀疑部分问题也可能出现在我的电子邮件宏中......

我放弃了XD

Answer 1

你的宏工作正常，我的意思是至少在你编码时。您需要删除宏的表单FOR循环。你可以做的只是获取更改的单元格的地址，并使用它来定义邮件地址和主题。像下面的东西

**工作表宏**

Public mailAddress As String
Public TargetRow As Long
Public mailSubject

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Value = "Overdue" Then
    mailAddress = Sheets("2015").Range("S" & Target.Row)
    mailSubject = Sheets("2015").Range("B" & Target.Row)
    TargetRow = Target.Row
    Call email
    ElseIf Target.Value = "Received" Then
        Call Macro1
End If

End Sub

你的宏应该喜欢这样的东西：

Sub email()
Dim OutApp As Object
Dim OutMail As Object
Dim FName As String


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
FName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    With OutMail
        .To = mailAddress
        .CC = ""
        .Subject = mailSubject
        .Body = "You have missed a valuation date for this project!"

        .Send
    End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

你可以尝试在这里发表答案吗？我现在没有excel，我无法尝试。