如何在 Outlook 中显示/发送带有可变 html 邮件正文内容的电子邮件（基于可变 Excel 单元格更改 - 基于列范围）

Question

How to Display/Send an email in Outlook (based on Excel cell change - based on a column range) with variable html mail body content?如何在 Outlook 中显示/发送带有可变 html 邮件正文内容的电子邮件（基于 Excel 单元格更改 - 基于列范围）？

Changing a value in a specific column (within the specified range) your excel file should trigger the macro to create an email with the content of that email built based on the values of different columns.更改特定列（在指定范围内）中的值，您的 excel 文件应触发宏以创建一封电子邮件，该电子邮件的内容基于不同列的值构建。

Answer 1

Insert the code in the Excel sheet module not as a separate module.将代码插入 Excel 工作表模块中，而不是作为单独的模块。

When there is a change in the specified sheet, it will trigger the code to generate a new email.当指定的工作表发生变化时，会触发代码生成新的电子邮件。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) 'Excel VBA to trap change to column "A".

Dim targetRng As Range
Dim Rng As Range
Dim c As Integer
Dim wb_Active As Workbook
Dim ws_Active As Worksheet

'We want to identify where the change was
Dim cell_row As Variant
Dim cell_col As Variant
cell_row = Target.row
cell_col = Target.Column
'    MsgBox "Cell " & Target.Address & " has changed."
'    MsgBox "Row " & Target.row & " has changed."
'    MsgBox "Column " & Target.Column & " has changed."

Dim OutApp As Object
Dim OutMail As Object
Dim File_Name As String
Dim mail_To As String
Dim mail_CC As String
Dim mail_BCC As String
Dim mail_Subject As String
Dim mail_Body As String
Dim Hyperlink_01 As String
Dim Hyperlink_02 As String

Dim Details_01 As String
Dim Details_Mail As String
Dim Details_phone As String
Dim Details_appointment As String
Dim Details_Unique_identifier As String
Dim Details_02 As String
Dim Details_03 As String
Dim Details_04 As String
Dim Details_05 As String
Dim Details_06 As String


Set wb_Active = ActiveWorkbook
Set ws_Active = wb_Active.ActiveSheet
  
'Duplicate (?)
Set wb_Active = ActiveWorkbook
Set ws_Active = ThisWorkbook.ActiveSheet
'End

'Each detail is related to a specific column if you ever add or remove a column please adapt the code accordingly
Details_Mail = Range("B" & cell_row).Value
Details_phone = Range("C" & cell_row).Value
Details_appointment = Range("D" & cell_row).Value
Details_Unique_identifier = Range("E" & cell_row).Value
Details_01 = Range("F" & cell_row).Value
Details_02 = Range("G" & cell_row).Value
Details_03 = Range("H" & cell_row).Value
Details_04 = Range("I" & cell_row).Value
Details_05 = Range("J" & cell_row).Value
Details_06 = Range("K" & cell_row).Value

  

'This is where you identify what is the range you want to monitor (I kept it simple with reference to a column with only 1000 rows and I was not planning on using more than 1000 rows for this code
Set targetRng = Intersect(Application.ActiveSheet.Range("A2:A1000"), Target)
If Not targetRng Is Nothing Then
    For Each Rng In targetRng
    If Not VBA.IsEmpty(Rng.Value) Then
        'Send mail
        'selected column "L" to receive "Last update" field that gets automatically updated when you change a value in column "A"
        Range("L" & cell_row).Value = Format(Now(), "yyyy-mm-dd")
        
        Hyperlink_01 = "http://stackoverflow.com/"  '& Details_Unique_identifier *** Please note that this additional ref can be used in case your hiperlink allows it i.e. http://site/unique_ref
        Hyperlink_02 = "<a href=" & Hyperlink_01 & ">SO</a>"
        'Hyperlink_02 = "<a href=" & Hyperlink_01 & ">" & Details_Unique_identifier & "</a>"
        mail_To = Details_Mail
        mail_CC = Details_06
        mail_BCC = ""
        mail_Subject = "Email  subject + any detail you want --> " & Details_02 & " - " & Details_03 & " - " & Details_Unique_identifier
        
        mail_Body = "<html><body>"
        mail_Body = mail_Body & "<body style=""font-family: Calibri; font-size: 14.5px; color:#203864; line-height: 1;"">"
        mail_Body = mail_Body & "Hello, <br /><br />blah blah blah " & Details_02 & " - " & Details_03 & "<br />"
        mail_Body = mail_Body & "Special reference to: <b>" & Hyperlink_02 & "</b><br />"
        mail_Body = mail_Body & "blah blah blah " & "<br />"
        mail_Body = mail_Body & "blah blah blah <b>" & Details_01 & "</b> mail: " & Details_Mail & " - Phone: " & Details_phone & "<br />"
        mail_Body = mail_Body & "blah blah blah: <b>" & Details_appointment & "</b><br /><br />"
        mail_Body = mail_Body & "blah blah blah " & Details_04 & "<br /><br />"
        mail_Body = mail_Body & "<b>Best Regards<br />"
        mail_Body = mail_Body & "Your Name </b><br />"
        
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = mail_To
            'With CreateObject("Outlook.Application").GetNamespace("MAPI")
            '.CC = .Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress
            .CC = mail_CC
            .BCC = mail_BCC
            .Subject = mail_Subject
            '.HTMLbody = mail_Body_01
            .HTMLbody = mail_Body
            '.Attachments.Add (File_Name)
            .Display
            '.Send
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        
        Else
          'Do Nothing...
      End If
      'MsgBox "Cell " & Target.Address & " has changed."
      Next
      Application.EnableEvents = True
End If
  
End Sub

如何在 Outlook 中显示/发送带有可变 html 邮件正文内容的电子邮件（基于可变 Excel 单元格更改 - 基于列范围）

问题描述

1 个解决方案

解决方案1
1 2020-01-22 19:08:12

如何在 Outlook 中显示/发送带有可变 html 邮件正文内容的电子邮件（基于可变 Excel 单元格更改 - 基于列范围）

问题描述

1 个解决方案

解决方案1 1 2020-01-22 19:08:12

解决方案1
1 2020-01-22 19:08:12