Question

当特定行的单元格中的值更改时，将发送邮件。

此外，我们现在想在任何情况下发送一个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

Answer 1

该代码的新版本似乎可以正常工作

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

发送有关值更改的Outlook任务

1 个答案: