Hi,
I am looking for a code that will create a new Outlook Task when someone enters a value in a specific row. I use below code that creates a automatic email when someone enters data in row D and would like the exact same result except that it creates an Outlook Task instead of a simple email when someone enters data in column 5.
Can you please let me know how to do this?
I really hope I can use the same code as down below just with a few changes;
Public Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailBody As String
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("D2:D400")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Möte med " & Cells(ActiveCell.Row, 1) & Cells(ActiveCell.Row, 4) & xRgSel.Address(False, False) & _
" in the worksheet '" & Me.Name & "' blev bokat " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" av " & Environ$("username") & "."
With xMailItem
.To = "xxx"
.Subject = "Nytt möte bokat - " & Cells(ActiveCell.Row, 1)
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am looking for a code that will create a new Outlook Task when someone enters a value in a specific row. I use below code that creates a automatic email when someone enters data in row D and would like the exact same result except that it creates an Outlook Task instead of a simple email when someone enters data in column 5.
Can you please let me know how to do this?
I really hope I can use the same code as down below just with a few changes;
Public Sub Worksheet_Change(ByVal Target As Range)
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailBody As String
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("D2:D400")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Möte med " & Cells(ActiveCell.Row, 1) & Cells(ActiveCell.Row, 4) & xRgSel.Address(False, False) & _
" in the worksheet '" & Me.Name & "' blev bokat " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" av " & Environ$("username") & "."
With xMailItem
.To = "xxx"
.Subject = "Nytt möte bokat - " & Cells(ActiveCell.Row, 1)
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub