从 Excel 复制和粘贴到 Outlook

Question

通过使用VBA，如果条件（大于数字2）在列“D”上为真，如何将Outlook电子邮件发送到保存在列“C”中的代理电子邮件，因此电子邮件将发送到保存在列单元格中的电子邮件同一行中的“C”表示电子邮件，D 表示条件？

例如：

Outlook 电子邮件的正文：

嗨！

您有未决报价，其编号

Dim valueForSubject as String, xRg As Range
'CYRIL ADDED valueForSubject ABOVE

'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("D2:D1000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 2 Then
        valueForSubject = Target.Value 'CYRIL ADDED, UNSURE OF ACTUAL VALUE
        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
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "You have pending quotation which its number" 
    On Error Resume Next
    With xOutMail
        .To = Target.Value
        .CC = ""
        .BCC = ""
        .Subject = valueForSubject & " other words" 'CYRIL ADDED, UNSURE OF OTHER WORDS WITHIN SUBJECT
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

.

.................................................. ..........

Answer 1

对评论的响应，使用另一个全局变量来捕获字符串，然后在电子邮件生成中使用所述 gvar：

Dim valueForSubject as String, xRg As Range
'CYRIL ADDED valueForSubject ABOVE

'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("D2:D1000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 2 Then
        valueForSubject = Target.Value 'CYRIL ADDED, UNSURE OF ACTUAL VALUE
        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
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "You have pending quotation which its number" 
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = valueForSubject & " other words" 'CYRIL ADDED, UNSURE OF OTHER WORDS WITHIN SUBJECT
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub