Philosophaie
Member
What I want to do is move a specified email "From" tag items to a certain folder whenever there is "New Mail" in the inbox.
Private Sub Application_NewMail()
Dim BillsEmailFrom(100), JunkEmailFrom(100), ForumsEmailFrom(100) As String
Dim numbills, numjunk, numforums As Double
Dim OLapp As New Outlook.Application
Dim OLns As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Bills As Outlook.MAPIFolder
Dim JunkEmail As Outlook.MAPIFolder
Dim Forums As Outlook.MAPIFolder
Dim mail As String
BillsEmailFrom(1) = "bill1"
BillsEmailFrom(2) = "bill2"
BillsEmailFrom(3) = "bill3"
numbills = 3
JunkEmailFrom(1) = "advertize@droz.com"
JunkEmailFrom(2) = "advertize@vitahealth.com"
numjunk = 2
Set OLns = OLapp.GetNamespace("MAPI")
Set Inbox = OLns.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items
Set PersonalFolder= Inbox.Folders("Personal Folders")
Set BillsFolder = PersonalFolder.Folders("Bills")
Set JunkFolder = PersonalFolder.Folders("Junk E-mail")
If Inbox.Items.Count = 0 Then Exit Sub
For iLoop = 1 To Inbox.Items.Count
For nb = 1 To numbills
If Inbox.Items(iLoop).From = BillsEmailFrom(nb) Then Item.Move BillsFolder
Next nb
For nj = 1 To numjunk
If Inbox.Items(iLoop).From = JunkEmailFrom(nj) Then Item.Move JunkFolder
Next nj
Next iLoop
Set ForumsFolder = Nothing
Set JunkFolder = Nothing
Set BillsFolder = Nothing
Set Items = Nothing
Set Inbox = Nothing
Set OLns = Nothing
End Sub
Private Sub Application_NewMail()
Dim BillsEmailFrom(100), JunkEmailFrom(100), ForumsEmailFrom(100) As String
Dim numbills, numjunk, numforums As Double
Dim OLapp As New Outlook.Application
Dim OLns As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim Bills As Outlook.MAPIFolder
Dim JunkEmail As Outlook.MAPIFolder
Dim Forums As Outlook.MAPIFolder
Dim mail As String
BillsEmailFrom(1) = "bill1"
BillsEmailFrom(2) = "bill2"
BillsEmailFrom(3) = "bill3"
numbills = 3
JunkEmailFrom(1) = "advertize@droz.com"
JunkEmailFrom(2) = "advertize@vitahealth.com"
numjunk = 2
Set OLns = OLapp.GetNamespace("MAPI")
Set Inbox = OLns.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items
Set PersonalFolder= Inbox.Folders("Personal Folders")
Set BillsFolder = PersonalFolder.Folders("Bills")
Set JunkFolder = PersonalFolder.Folders("Junk E-mail")
If Inbox.Items.Count = 0 Then Exit Sub
For iLoop = 1 To Inbox.Items.Count
For nb = 1 To numbills
If Inbox.Items(iLoop).From = BillsEmailFrom(nb) Then Item.Move BillsFolder
Next nb
For nj = 1 To numjunk
If Inbox.Items(iLoop).From = JunkEmailFrom(nj) Then Item.Move JunkFolder
Next nj
Next iLoop
Set ForumsFolder = Nothing
Set JunkFolder = Nothing
Set BillsFolder = Nothing
Set Items = Nothing
Set Inbox = Nothing
Set OLns = Nothing
End Sub