FryW
Member
- Outlook version
- Outlook 365 64 bit
- Email Account
- Outlook.com (as MS Exchange)
On in coming emails, if title and sender match the IFs then auto set "follow up" for today with a custom reminder time for between 3pm and 3:30pm.
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
MessageInfo = "" & _
"Sender : " & Item.SenderEmailAddress & vbCrLf & _
"Sent : " & Item.SentOn & vbCrLf & _
"Received : " & Item.ReceivedTime & vbCrLf & _
"Subject : " & Item.Subject & vbCrLf & _
"Size : " & Item.Size & vbCrLf & _
"Message Body : " & vbCrLf & Item.Body
'Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
If (Item.Subject = "Frytest" & Item.SenderEmailAddress = "Fry@gmail.com") Then
Dim max, min
max = 29
min = 1
Randomize
rT = response.Write(Int((max - min + 1) * Rnd + min))
MagBox rT
With Item
.FlagRequest = "Type the custom follow-up notes here"
.MarkAsTask olMarkToday
'Set a custom due date
.TaskDueDate = Date
'.DueDate = Date + 7.5
.DueDate = Date
.ReminderSet = True
'.ReminderTime = objTask.DueDate - 0.25
.ReminderTime = "#" & Date & " 3:" & rT & ":00 PM#"
'.ReminderTime = #10/10/2005 12:00:00 PM#
.Save
End With
End If
End If
ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem
End Sub
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim MessageInfo
Dim Result
If TypeName(Item) = "MailItem" Then
MessageInfo = "" & _
"Sender : " & Item.SenderEmailAddress & vbCrLf & _
"Sent : " & Item.SentOn & vbCrLf & _
"Received : " & Item.ReceivedTime & vbCrLf & _
"Subject : " & Item.Subject & vbCrLf & _
"Size : " & Item.Size & vbCrLf & _
"Message Body : " & vbCrLf & Item.Body
'Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
If (Item.Subject = "Frytest" & Item.SenderEmailAddress = "Fry@gmail.com") Then
Dim max, min
max = 29
min = 1
Randomize
rT = response.Write(Int((max - min + 1) * Rnd + min))
MagBox rT
With Item
.FlagRequest = "Type the custom follow-up notes here"
.MarkAsTask olMarkToday
'Set a custom due date
.TaskDueDate = Date
'.DueDate = Date + 7.5
.DueDate = Date
.ReminderSet = True
'.ReminderTime = objTask.DueDate - 0.25
.ReminderTime = "#" & Date & " 3:" & rT & ":00 PM#"
'.ReminderTime = #10/10/2005 12:00:00 PM#
.Save
End With
End If
End If
ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ExitNewItem
End Sub