Отправить задачу Outlook при изменении значения - PullRequest
Новая
       7

Отправить задачу Outlook при изменении значения

0 голосов
/ 04 октября 2018

Почта отправляется при изменении значения в ячейке определенной строки.

Кроме того, теперь мы хотим отправлять задачу Outlook всякий раз, когда это происходит.Следующая первая часть - это электронное письмо. 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OutApp As Object, OutMail As Object, strbody As String
    If Target.Column = 44 Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        strbody = "Text "
        On Error Resume Next
        With OutMail
            .To = Sheets("Param").Cells(3, 4)
            .CC = ""
            .BCC = ""
            .Subject = "Text"
            .Body = strbody
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
        Exit Sub
    End If
End Sub

Пока здесь не работает код.Я добавил часть о задаче, и хотя код работает без оператора IF THEN, я не могу заставить его сработать, или я получаю ошибку 424. 

Private Sub SendTask()
    Dim objOut As Outlook.Application
    Dim objTask As Outlook.TaskItem
    Dim blnCrt As Boolean
    If Target.Column = 6 Then 'modification numéro agrément
        On Error GoTo CreateOutlook
        Set objOut = GetObject(, "Outlook.Application")
CreateItem:
        On Error GoTo 0
        Set objTask = objOut.CreateItem(olTaskItem)
        With objTask
            .Assign
            .Subject = "You need to fix this!"
            .Body = "Please fix this problem by " & Format(Now + 10, "mm/dd/yy")
            .DueDate = CDate(Now + 10)
            .Recipients.Add ("youremail@domain.com")
            .Display
        End With
        If blnCrt = True Then objOut.Quit
        Set objTask = Nothing
        Set objOut = Nothing
        Exit Sub
CreateOutlook:
        Set objOut = CreateObject("Outlook.Application")
        blnCrt = True
        Resume CreateItem
    End If
End Sub

1 Ответ

0 голосов
/ 04 октября 2018

Новая версия кода, которая работает как задумано 

Private Sub Worksheet_Change(ByVal target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String


If target.Column = 6 Then 'Modification of value in row 6
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olTaskItem)



    With OutMail
     .Assign
     .Subject = "You need to fix this!"
     .Body = "Please fix this problem by " & Format(Now + 10, "mm/dd/yy")
     .DueDate = CDate(Now + 10)
     .Recipients.Add ("youremail@domain.com")
     .Display
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Den numèro d'agrément "


    With OutMail
        .To = Sheets("Param").Cells(3, 4)
        .CC = ""
        .BCC = ""
        .Subject = "Fichier acquéreur: modification numéro agrément"
        .Body = strbody
        .Display   
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
    Exit Sub
End If
End Sub
...