Results 1 to 2 of 2

Thread: vba timer outlook

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Regular
    Joined
    Sep 2011
    Posts
    6
    Location
    just rewrote everything, now it,s checking every 5 minutes with the new code on all active mailboxes ( except for the if )

    code in Module:
    Public foldernaam As Variant  'use as shared folder variable name
    Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong, _
     ByVal uElapse As LongLong, ByVal lpTimerfunc As LongLong) As LongLong
    Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong) As LongLong
    Public TimerID As LongLong 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running
    
    Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
    'MsgBox "The TriggerTimer function has been automatically called!"
    ShowActiveMailboxes
    End Sub
    
    Public Sub DeactivateTimer()
    Dim lSuccess As LongLong
    lSuccess = KillTimer(0, TimerID)
    If lSuccess = 0 Then
       MsgBox "The timer failed to deactivate."
       Else
       TimerID = 0
    End If
    End Sub
    
    Public Sub ActivateTimer(ByVal nMinutes As Long)
    nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes
    If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer
      TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
         If TimerID = 0 Then
           MsgBox "The timer failed to activate."
           MsgBox (myVariable)
        End If
    End Sub
    
    Public Sub ShowActiveMailboxes()
    Dim olApp As Outlook.Application
    Set olApp = Outlook.Application
    Dim ns As Outlook.NameSpace
    Set ns = olApp.GetNamespace("MAPI")
    Dim fldr As Outlook.MAPIFolder
    For Each fldr In ns.Folders
       If fldr.DefaultItemType = olMailItem Then
          foldernaam = fldr
              If foldernaam Like "*Archi*" Then
                 'do nothing
                 ElseIf foldernaam = "No Reply" Then
                 'do nothing
                 ElseIf foldernaam Like "*IT Supp*" Then
                 'sla over
                 Else
                 'MsgBox (foldernaam)
                Call extra
            End If
       End If
    Next
    End Sub
    
    Public Sub extra()
    'MsgBox ("check unread mail in all active mailboxes ") & foldernaam
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objFolder As Outlook.Folder
    Dim subfolder As Outlook.Folder
    Dim objMailbox As Outlook.Recipient
    Dim Items2 As Outlook.Items
    Dim mail As Object
    Dim x As Long
    Dim Item3 As Object
    Set objOutlook = Outlook.Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objMailbox = objNamespace.CreateRecipient(foldernaam)
    Set objFolder = objNamespace.GetSharedDefaultFolder(objMailbox, olFolderJunk)
    Set subfolder = objNamespace.GetSharedDefaultFolder(objMailbox, olFolderInbox)
    Set mail = objFolder
    Set Items2 = mail.Items
    For x = Items2.Count To 1 Step -1
        DoEvents
        'MsgBox check for all items junkbox
        Set Item3 = Items2(x)
        Item3.Subject = "[Possible Spam] " & Item3.Subject
        Item3.Save
        Item3.Move subfolder
    Next
    End Sub
    Code in Thisoutlook session ( it only activates the timer

    Private Sub Application_Quit()
    If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **VERY IMPORTANT**
    End Sub
    
    Private Sub Application_Startup()
    Call ActivateTimer(5) 'Set timer to go off every 5 minute
    End Sub
    Last edited by Aussiebear; 02-09-2023 at 09:32 AM. Reason: reduced wasted whitespace

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •