时间戳

首页 > 解决方案 > 根据单元格中的名称发送电子邮件

vba - 根据单元格中的名称发送电子邮件

问题描述

如果一系列单元格中的值发生变化，我已经查看了多个帖子以发送电子邮件，并调整了我在这些帖子中找到的代码以满足我的需要，但由于某种原因，当任何单元格中的值发生变化时，电子邮件不会被发送定义的范围发生了变化，我对为什么有点迷茫。非常感谢任何指导。请参阅下面的代码（请注意，出于保密目的，电子邮件和姓名是假的）。

Private Sub Workbook_Change(ByVal Target As Range)
'   Uses early binding
'   Requires a reference to the Outlook Object Library
    Dim RgSel As Range, RgCell As Range
    Dim OutlookApp As Object, MItem As Object
    Dim Subj As String, EmailAddr As String, Recipient As String
    Dim CustName As String, Msg As String
    Dim pEmail As String

    On Error GoTo NX

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

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

    If Not RgSel Is Nothing Then
        Set OutlookApp = CreateObject("Outlook.Application")
        Set MItem = OutlookApp.CreateItem(0)
            For Each cell In RgCell
                If cell.Value = "Bob" Then                      'Fake Name for posting question
                    pEmail = "BobT@SomethingBlahBlahBlah.com"   'Fake email address used for posting question
                    CustName = cell.Offset(0, -1).Value
                    Subj = "***NEW ITEM ASSIGNED***" & " - " & UCase(CustName)
                    Recipient = "Bob T. Builder"                'Fake name for posting question
                    EmailAddr = pEmail

                '   Compose Message
                    Msg = "Dear, " & Recipient & vbCrLf & vbCrLf
                    Msg = Msg & "I have assigned " & CustName & "'s" & " item to you." & vbCrLf
                    Msg = Msg & "Please review the information in their customer folder in the L: Drive." & vbCrLf & vbCrLf
                    Msg = Msg & "Sincerely," & vbCrLf & vbCrLf & vbCrLf
                    Msg = Msg & "Bob's Boss" & vbCrLf           'Fake name for posting question
                    Msg = Msg & "Vice President"

                '   Create Mail Item and send
                    With MItem
                        .to = EmailAddr
                        .Subject = Subj
                        .body = Msg
                        .Save   'This will change to .send after testing is complete
                    End With
                    Set RgSel = Nothing
                    Set OutlookApp = Nothing
                    Set MItem = Nothing
                End If

            Next cell
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

NX:
    Resume Next
End Sub

标签： vbaexcelexcel-2013

解决方案

我认为您打算使用该Worksheet_Change事件，但Private Sub Workbook_Change...改为使用该事件。

附加问题：

  • For Each cell In RgCell可能应该是For Each cell in RgSel, 或For Each cell in Target- 否则代码会遍历 中的每个单元格C2:C100，而不仅仅是更改的单元格或Target.
  • 没有必要Set RgSel = Nothing
  • 使用，您可以在检查之前Set MItem = OutlookApp.CreateItem(0)创建一封电子邮件。在语句中移动这一行。If cell.Value = "Bob"If
  • Set OutlookApp = Nothing应该在循环之外For Each，即它应该在你完成循环之后完成。
  • On Error GoTo NX, 然后NX: Resume Next, 等价于On Error Resume Next，它不处理任何错误，而是忽略它们。
  • 您可能缺少结束语End If，或者它不包含在此代码段中。

推荐阅读