CODEWITHSUNDEEP
vbaoutlook
Keagan Hill
Keagan Hill

Reputation: 33

How can I make my VBA macro run every minute in Outlook?

I have a vba command set to a button on the top left of Outlook. This button moved all my read mail into my reviewed folder. However, I don't want to have to click the button every time I read a mail.

Is there a way I can automate that button, and if so, How?

Sub MoveInbox2Reviewed()
On Error Resume Next
Set oOutlook = CreateObject("Outlook.Application")

Set oNamespace = oOutlook.GetNamespace("MAPI")

Set oFolderSrc = oNamespace.GetDefaultFolder(olFolderInbox)

Set oFolderDst = oFolderSrc.Folders("Reviewed")

Set oFilteredItems = oFolderSrc.Items.Restrict("[UnRead] = False")

For Each oMessage In oFilteredItems

    oMessage.Move oFolderDst
Next
End Sub

Upvotes: 1

Views: 747

Answers (2)

0m3r
0m3r

Reputation: 12499

How about ItemChange event, the change Occurs when an item in the specified collection is changed

Example

Option Explicit
Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
    
End Sub

Private Sub Items_ItemChange(ByVal Item As Object)
    Dim olNs As Outlook.NameSpace
    Dim Sub_Folder  As Outlook.MAPIFolder


    Set olNs = Application.GetNamespace("MAPI")
    Set Sub_Folder = olNs.GetDefaultFolder(olFolderInbox) _
                                .Folders("Reviewed")


    If TypeOf Item Is Outlook.MailItem Then
    
        If Item.UnRead = False Then
            Debug.Print Item.Subject ' Immediate Window
            Item.Move Sub_Folder
        End If

    End If
    
End Sub

Code should be under ThisOutlookSession

Upvotes: 1

Paul Ogilvie
Paul Ogilvie

Reputation: 25266

I partially tested the following code:

First a demo version:

Private Sub Application_StartupX()
Dim PauseTime, Start, demo
    demo = 100
    Do
        PauseTime = 5    ' Set duration.
        Start = Timer    ' Set start time.
        Do While Timer < Start + PauseTime
            DoEvents    ' Yield to other processes.
        Loop
        ' do your things
        demo = demo - PauseTime
    Loop While demo > 0
    MsgBox "done"
End Sub

And this is the real thing:

Private Sub Application_Startup()
Dim PauseTime, Start
    Do
        PauseTime = 5    ' Set duration.
        Start = Timer    ' Set start time.
        Do While Timer < Start + PauseTime
            DoEvents    ' Yield to other processes.
        Loop
        ' do your things
    Loop
    ' never ends
End Sub

It uses the Application.StartUp event from which it never returns but gives DoEvents for the processing of windows messages. I did not test the real StartUp event, but the demo version works.

Note: see for a possible alternative VBA Macro On Timer style to run code every set number of seconds, i.e. 120 seconds. I run Office 2008, which Outlook doesn;t have this property.

Upvotes: 1

Related Questions