PopUp or Alert when folder count exceeded

[user-123]

Hello other VBA users! I'm looking to for input and assistance

I need to get a popup, msgbox or alert sent to my cellphone when a certain number of emails received in one day.

Example: email received in shared inbox(folder) >25 times in one day notify my cell ASAP!

[Logit]

.
The following macro will display how many emails exist in the INBOX folder. If you connect the macro to a timer macro that runs say every 15 minutes or whatever, then instead of the MsgBox notification
you can include code that determines when the number is 25 or greater. At that point you can fire another macro to send a text message to your cell phone.




Option Explicit


Sub HowManyEmails()
Dim objOutlook As Object, objnSpace As Object, objFolder As Object
Dim EmailCount As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")


On Error Resume Next
Set objFolder = objnSpace.Folders("Personal Folders").Folders("Inbox")
If Err.Number <> 0 Then
Err.Clear
MsgBox "No such folder."
Exit Sub
End If


EmailCount = objFolder.Items.Count
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing


MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
End Sub


Here is a resource for sending your text message : http://www.vbaexpress.com/forum/showthread.php?15188-sending-SMS-by-VBA

[user-123]

Logit - This macro is great. Thanks! I just edited the "Personal Folders" to one of the 6 server inboxes I currently have.
A timed macro would be good. However, for urgent email issues this might be a snag for me. I won't be at the Inbox all day and could be in a meeting and when greater than XX is when I would want a urgent email to me sent to my phone. I saw the message link and can use the correct carrier to forward the email.

With the script you shared - Where can I adjust it to send to my cell or auto run?
Email = >1 or >2 or >25?

[Logit]

.
Well ... this is one way. Add the following :



Option Explicit


Sub HowManyEmails()
'all the other lines of code previous to the following :


EmailCount = objFolder.Items.Count
Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing


If EmailCount > 1 Then 'change number here / replace the next line with the call to macro for sending txt message.
MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
End If


End Sub


However, you are still going to need a macro to run the above macro periodically ... which requires a timer. You can set the timer to fire every minute or every 5 minutes or however you want.

[user-123]

Outstanding. I'll try this tomorrow. I'll respond back if I have more issues/questions. Really appreciate your help.
Below is a different macro that works for auto.forwarding a particular daily report from a server gets then gets forwarded to external contacts. It seems to run fine except when other emails that have a calendar invite (not even with the same subject line) in the email and it also forwards that. What input do you have?


In ThisOutlookSession:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items

End Sub


Private Sub Items_ItemAdd(ByVal Item As Object)

'On Error GoTo ErrorHandler



Dim msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Set msg = Item
If (msg.Subject Like "I changed this just now – ignore the subject string") And _
(msg.Attachments.Count >= 0) Then


Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim Att As String
' On Error Resume Next
Const attPath As String = "C:\Users\xxxxxx\Desktop\removed the real name"

On Error Resume Next
Set myAttachments = Item.Attachments
Att = myAttachments.Item(1).DisplayName
myAttachments.Item(1).SaveAsFile attPath & Att

msg.UnRead = False
End If
End If

'new test
On Error Resume Next
If (msg.Subject Like "* I changed this just now – ignore the subject string *") And _
(msg.Attachments.Count >= 0) Then
Call frwdemail
End If

End Sub



In a module:
Sub frwdemail()

Dim OutApp As Object
Dim OutMail As Object
Dim sTempFilePath As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
sTempFilePath = ("my .xlsx file location ")
On Error Resume Next
With OutMail
.To = “emailhere” ‘email info was removed
.CC = "" ‘‘email info was removed
.Subject = "removed " & Format(Date, "mm_dd_yyyy")
.HTMLBody
.Attachments.Add (“xxxx.xlsx") ‘removed folder location name but it does grab my file and attaches it just fine
Kill sTempFilePath
.Display
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

[user-123]

.
However, you are still going to need a macro to run the above macro periodically ... which requires a timer. You can set the timer to fire every minute or every 5 minutes or however you want.


Logit - What I ended up doing vs a defined timer is this:
ThisOutlookSession:
Private Sub Items_ItemAdd(ByVal Item As Object)
Call Howmanyemails 'I changed the real macro name but once I edited the >xxx count it works like a charm! Thanks so much. Please PM me w/your email addi.
end sub

[Logit]

.
Hmmm ... I haven't seen your solution before. And admittedly I've not messed with Outlook much either other than create Email Macros in VBA Excel.

Would be interesting to see your entire code so I can try to understand how it functions.

Will send pm.

Thanks.