Thursday, August 2, 2012

VBA code that monitor inbox emails

this code will monitor outlook 2010 inbox email,if it come from specified people,then move email to specified    folder and if the email is come in weekend,then it will forward this email to another gmail account

---------------------------------------------------------------------------------------

Private WithEvents myOlItems  As Outlook.Items
Private kitty As Outlook.Folder

Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
      Set olApp = Outlook.Application
      Set objNS = olApp.GetNamespace("MAPI")
      Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
      'Set myOlItems = objNS.Folders("dwei@companyname.com").Folders("kitty").Items
      Set kitty = objNS.Folders(1).Folders("kitty")
     
End Sub

Private Sub myOlItems_ItemAdd(ByVal item As Object)

On Error GoTo ErrorHandler

  Dim Msg As Outlook.MailItem
  Dim myFwd As Outlook.MailItem
  Dim we As Boolean

  If TypeName(item) = "MailItem" Then
    Set Msg = item

    'MsgBox Msg.Subject
    'MsgBox Msg.Body
    If Msg.Sender = "Kitty Luo" Then
        we = Application.IsWeekendDay(Now)
        If (we) Then
            Set myFwd = Msg.Forward
            myFwd.Recipients.Add "test@gmail.com"
            myFwd.Send
        End If
       
        Msg.Move kitty
       
        Set myFwd = Nothing
    End If

  End If

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Sub MoveToFolder(folderName)

 mailboxNameString = "Inbox"

 Dim olApp As New Outlook.Application
 Dim olNameSpace As Outlook.NameSpace
 Dim olCurrExplorer As Outlook.Explorer
 Dim olCurrSelection As Outlook.Selection

 Dim olDestFolder As Outlook.MAPIFolder
 Dim olCurrMailItem As MailItem
 Dim m As Integer

 Set olNameSpace = olApp.GetNamespace("MAPI")
 Set olCurrExplorer = olApp.ActiveExplorer
 Set olCurrSelection = olCurrExplorer.Selection

 Set olDestFolder = olNameSpace.Folders(mailboxNameString).Folders(folderName)

 For m = 1 To olCurrSelection.Count
    Set olCurrMailItem = olCurrSelection.item(m)
    Debug.Print "[" & Date & " " & Time & "] moving #" & m & _
                ": folder = " & folderName & _
                "; subject = " & olCurrMailItem.Subject & "..."
    olCurrMailItem.Move olDestFolder
 Next m

End Sub

Function IsWeekendDay(MyDate As Variant) As Boolean
   
    Dim DayNum As Variant
    Dim IsWeekend As Boolean
   
    DayNum = Weekday(MyDate)
   
    Select Case DayNum
        'Case vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday
        Case vbSaturday, vbSunday
            IsWeekendDay = True
        Case Else
            IsWeekendDay = False
     End Select
End Function

No comments:

Post a Comment