Thread: [Solved] Help to create a rule
View Single Post
 
Old 06-15-2016, 09:47 AM
kwrelzz kwrelzz is offline Windows 7 64bit Office 2013
Novice
 
Join Date: Jun 2016
Posts: 5
kwrelzz is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
If you put the following in the ThisOutlookSession module, and run the Application_Startup macro (or restart Outlook - not forgetting to save the project) when a file is moved to the Maria Alencar (which I assume is you) sub folder, you will hear the Windows Notify sound from C:\Windows\Media and see a message box.

Note that Outlook is very fussy about security, so you will almost certainly need to self certify the macro project - see http://www.gmayor.com/create_and_emp...gital_cert.htm
Code:
Option Explicit

#If Win64 Then
Private Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
        (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#Else
Private Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
                                        (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#End If

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim olApp As Outlook.Application
    Set olApp = Outlook.Application
    Set Items = GetNS(olApp).GetDefaultFolder(olFolderInbox).folders("Maria Alencar").Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler
    PlayASound "Notify"
    MsgBox "There's a new item in Mary's folder."
ProgramExit:
    Exit Sub
ErrorHandler:
    Beep
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Private Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
    Set GetNS = app.GetNamespace("MAPI")
End Function

Private Sub PlayASound(ByVal pSound As String)
    If Dir(pSound, vbNormal) = "" Then
        pSound = Environ("WinDir") & "\Media\" & pSound
        If InStr(1, pSound, ".") = 0 Then pSound = pSound & ".wav"
        If Dir(pSound, vbNormal) = vbNullString Then
            Beep
            Exit Sub
        End If
    End If
    DoEvents
    sndPlaySound32 pSound, 0&
    DoEvents
lbl_Exit:
    Exit Sub
End Sub
Hello gmayor.

Thanks for the answer,

When i put this code on my "ThisOutlookSession", I get this error message, even when I put all the macros on.

Can you help me about that?

Thank you so much!
Attached Images
File Type: png Untitled 1.png (53.5 KB, 17 views)
Reply With Quote