简体   繁体   中英

How to Display/Send an email in Outlook (based on variable Excel cell change - based on a column range) with variable html mail body content

How to Display/Send an email in Outlook (based on Excel cell change - based on a column range) with variable html mail body content?

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.

Insert the code in the Excel sheet module not as a separate module.

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

基于通用代码的示例

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM