Вставьте код в файл Excel (нажмите Alt + F11), скопируйте и вставьте его в фактический лист , а не как отдельный модуль. Если у вас есть вопросы, выполните поиск по событию topi c -> Worksheet.Change (Excel). Когда в указанном листе произойдут изменения, он вызовет код для создания нового электронного письма.
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
Надеюсь, это поможет вам, ребята, я знаю, что мне потребовалось некоторое время, чтобы настроить это решение, поскольку я пришлось создавать его на основе отдельных битов кода.