Help to create a rule

kwrelzz · #1 06-14-2016, 07:47 AM

Hello there,

I'm creating this post because I cant find anything about it in any forums on the internet, maybe you guys can help me.

I have one e-mail account that have a lot of other subdirectories, so I need one rule for alert person when a new e-mail has moved or arrive into a especific directory.

An example:

My name is Maria and I have a directory with this name, so, when I receive a new message in this subdirectory, it will play a sound alert or a desktop alert

In attached files you guys can see the structure of my Outlook.

Is it possible?

Thank you guy so much, and I'm sorry if i create this post in the wrong area, Im noob.

Edit1: Every name on this print screen is one of our people, who need to be alert when the new message arrive.

gmayor · #2 06-15-2016, 04:41 AM

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

kwrelzz · #3 06-15-2016, 09:47 AM

Quote:

Originally Posted by gmayor

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!

gmayor · #4 06-15-2016, 08:15 PM

The red text suggests that you don't have the appropriate sounds dll installed, so delete the previous macros and use the following simpler version instead. The yellow line may reflect the above error, or it could indicate that the Maria folder is not a sub folder of the default inbox. If that is the case I would need to know your Outlook folder structure in order to suggest changes.

Code:

Option Explicit
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
    Beep
    MsgBox "There's a new item in Maria'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

kwrelzz · #5 06-16-2016, 05:31 AM

Hello,

Thanks again for the answer, mate

If helps you to helps me (), I'm attaching my e-mail structure.

And yeah, you're right! Maria Alencar's is not a subdirectory from my default account, but i didnt know how to configure "falecomrobson' as default.

Thanks a lot,

gmayor · #6 06-16-2016, 07:19 AM

Open the immediate window of the VBA editor (Ctrl+G)
Then add the following to a module

Code:

Sub GetFolderNames()
Dim olStore As Outlook.Store
Dim olFolder As Folder
    For Each olStore In Session.Stores
Debug.Print olStore.DisplayName
        For Each olFolder In olStore.GetRootFolder.folders
Debug.Print vbTab & vbTab & olFolder.Name
        Next olFolder
    Next olStore
End Sub

Run the macro then copy and paste the contents of the Immediate window to your next reply. Hopefully falecomrobson is one of the listed folders, from which it should be easy enough to derive the required subfolder

kwrelzz · #7 06-16-2016, 10:32 AM

Hi gmayor,

It works!

But just works when I create "Maria Alencar" directory as a subdirectory of Account 1, don't work when I move a e-mail to "falecomrobson's" Maria Alencar's directory :/

What change I have to do here?

May I have to turn falecomrobson's my default account?

Thanks man, you're awesome.

gmayor · #8 06-16-2016, 08:28 PM

What works? Post the result of the last macro as requested.

kwrelzz · #9 06-17-2016, 10:22 AM

Hello,

Sorry, didnt see the rest of your message, because a I thought it was part of your signature ¬¬'

I put the macro just like you said, but it just works when the "Maria Alencar's" folder is a subdirectory of my "account1", and I need it to work when it is a subdirectory of @falecomrobson's mail account.

Here is the print attached.

Thank you again.

gmayor · #10 06-17-2016, 08:29 PM

That's not what I need to see. Re-read the message. Open the VBA editor Immediate Window. Run the GetFolderNames macro. Copy and paste the content of the Immediate Window into your message.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Rule to forward email using rule to me@onenote.com	anony1	OneNote	2	02-04-2023 02:39 PM
create rule to copy sent items to specified folder	shmu	Outlook	0	12-15-2015 04:08 AM
Mail merge from excel - need to create sheets and create a table	bluenosebex	Mail Merge	5	08-02-2015 05:34 PM
Rule to turn off a rule	tiger10012	Outlook	2	02-23-2013 09:50 AM
Create Rule to forward message to mobile#	JoyConner	Outlook	1	04-21-2011 05:44 PM