将值分配给变量 SendTo 以获取自动电子邮件答案

【问题标题】：Assign the value to Variable SendTo for automatic email将值分配给变量 SendTo 以获取自动电子邮件
【发布时间】：2021-08-30 13:26:53
【问题描述】：

如果 Q 列 应用条件并且此条件表示如果天数大于 2 ，将发送自动电子邮件，则我已经编写了这些代码以从 excel 发送自动电子邮件到列 "C" 在列 Q 中满足的条件的同一行 中的代理电子邮件。现在，以下代码运行，但它被发送到仅在“C”列的第 5 单元格中的代理电子邮件；但是，我的目标是在同一 Row 的 Q 列中满足条件时，在“C”列中向代理发送电子邮件。请指教。

Dim xRg As Range


'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("Q5:Q1000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 2 Then
     
        Call Mail_small_Text_Outlook
    End If
    
  
    
    
End Sub
Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim sendTo As Variant


sendTo = Range("C5").Value


    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi" & vbNewLine & vbNewLine & _
              "This is a reminder that you have one past due Qoutation Request " & vbNewLine & _
              "its details as per the following , please take an instant action :"
    On Error Resume Next
    With xOutMail
         
        .To = sendTo
        
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

【问题讨论】：

标签： excel vba outlook

【解决方案1】：

有多种方法可以做到这一点。

这是一个使用模块级变量xRg。

Option Explicit

Dim xRg As Range

'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("Q5:Q1000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 2 Then

        Call Mail_small_Text_Outlook
    End If

End Sub

Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim sendTo As Variant

    sendTo = Intersect(Range("C:C"), xRg.EntireRow).Value

    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi" & vbNewLine & vbNewLine & _
                "This is a reminder that you have one past due Qoutation Request " & vbNewLine & _
                "its details as per the following , please take an instant action :"
    On Error Resume Next
    With xOutMail

        .To = sendTo

        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    
End Sub

【讨论】：