Добавить значения ячеек в электронную почту при их изменении Excel - PullRequest
0 голосов
/ 28 сентября 2018

В настоящее время я работаю над небольшой "базой данных" Excel, где ячейки в одном из столбцов могут редактировать несколько человек.Ячейки, которые можно редактировать, находятся в раскрывающемся меню.Как только человек меняет одну или несколько ячеек, я хотел бы, чтобы некоторые данные в соответствующих строках были добавлены в электронное письмо.Наконец, фиксированная ячейка заполняется инициалами человека, редактирующего базу данных, в результате чего электронное письмо отправляется.

Пример.Мои столбцы A, B и C: Имя , Профессия , Статус и, скажем, у меня есть 10 строк.Затем ячейка Status в строках 2 и 7 изменяется с помощью выпадающего меню с «Working» на «On Holiday».Я добавляю свои инициалы в фиксированную ячейку (например, D1), и создается электронное письмо со следующим текстом:

Отметка, В выходной

Стэн, В выходной

Колонка B, Профессия , не важна и должна быть исключена из электронного письма.

Заранее спасибо

Текущий (неполный) код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xChangeArea As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xChange = Range("$D$1")
    Set xChangeArea = Intersect(Target, xChange)
    ActiveWorkbook.Save
    If Not xChangeArea Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Changes made in document: " & "(A Column Cell) is set to" & "(C column cell)"

        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            '.Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xChangeArea = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...