Пожалуйста, добавьте событие Worksheet_Change на кодовую страницу вашего рабочего листа, где у вас есть данные, как показано на снимке. Откройте редактор VB, нажав клавишу F11.Затем вы нажимаете на лист, он откроет кодовую страницу листа.В раскрывающемся списке выберите «Изменить», и на кодовую страницу будет добавлена подпрограмма.Вставьте код в эту процедуру.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 Then 'e.g. for column G
Sendmail 'name of your sub
End If
End Sub
Настройка нашего листа похожа на снимок, показанный ниже.
Я рассмотрел следующие пункты.
- Должно быть только предупреждение, и система не должна автоматически отправлять письма без просмотра.Часто события рабочего листа дают неожиданные результаты, так как здесь требуется такая осторожность.
- Чтобы предоставить последний статус, я ввел следующую формулу в ячейку
F2, которая будет "YES" или "NO" в зависимости от даты в ячейке D2 и статуса E2. - Для правильной работы события рабочего листа необходимо щелкнуть ячейку в
Column G.Я добавил кнопку управления формой в ячейку G2.Если статус да, нажмите кнопку в G2, чтобы отправить письмо. - Теперь вставьте модуль в рабочую книгу в VBE и введите код
Sendmail в этот модуль. Тема находится в ячейке F1, тело сообщения, кроме общих приветствий, находится в ячейке B1, Имя получателя находится в ячейке C2
Sub Sendmail()
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
Dim answer As String
Dim SubmitLink As String
Dim KeyCells As Range
Set KeyCells = Range("F2:F100")
SubmitLink = Range("B1").Value
answer = MsgBox("Do you wish to save this change. An Email will be sent to the User", vbYesNo, "Save the change")
If answer = vbNo Then Cancel = True
If answer = vbYes Then
Application.EnableEvents = False
Application.ScreenUpdating = False
'open outlook type stuff
Set OutlookApp = CreateObject("Outlook.Application")
Set OlObjects = OutlookApp.GetNamespace("MAPI")
Set newmsg = OutlookApp.CreateItem(olMailItem)
On Error Resume Next
'add recipients
'newmsg.Recipients.Add ("Name Here")
newmsg.Recipients.Add Worksheets("Sheet1").Range("C2").Value
'add subject
newmsg.Subject = Worksheets("Sheet1").Range("F1").Value
'add body
newmsg.Body = "Dear Customer, " & SubmitLink & vbLf & vbLf & vbLf & " Look Forward to your confirmation" & vbLf & vbLf & vbLf & "Sincerely," & vbLf & "Customer Care department"
newmsg.Display 'display
newmsg.Send 'send message
'give conformation of sent message
MsgBox "Modification confirmed", , "Confirmation"
End If
' MsgBox "Cell " & Target.Address & " has changed."
On Error GoTo 0
Set newmsg = Nothing
Set OutlookApp =Nothing
End Sub
РЕДАКТИРОВАТЬ: OP комментирует расположение кодов, показанных на снимках
