Hi dears!
I am into an Enterprise environment, where I have my main mailbox and moreover I have full access permissions on another mailbox.
So I have configured Outlook just with my mailbox but it let me automatically see two mailbox on the left: MY-ONE and the OTHER-ONE.
I'm trying to write a vba script to move mails within the same mailbox, just into another folder (so not from one mailbox to the other one).
The vba script is configured as an action of a rule, and it receives an Outlook.MailItem as a parameter.
In other words I want to manually execute that rule on any folder of any mailbox and get a move of matching mail (based on subject) into another folder (based on subject) in the same mailbox of the Outlook.MailItem object.
This is what I have done until now (it is boring but I will comment every line to explain what it does in my mind):
Public Sub AppResponseManage(Item As Outlook.MailItem)
Dim myOlApp
Dim myOlNameSpace
Dim objInboxFolder
Dim objProjectFolder
Dim itms
Dim ItemCount, UnReadItemCount
Dim a, b, c, d
Set myOlApp = Item.Application ' define the app environment based on the mail received as a parameter
Set myOlNameSpace = myOlApp.Session ' define the namespace environment based on the mail received as a parameter
Dim mailbox, inbox
Set mailbox = Item.Parent.Store.GetRootFolder ' get the mailbox to which the mail belongs
Set inbox = Item.Parent.Store.GetDefaultFolder(olFolderInbox) ' get the inbox folder of the above mailbox
Set objInboxFolder = myOlNameSpace.folders(mailbox.Name).folders(inbox.Name) ' define the inbox folder based on the two above
Dim sendName, errorName, deviceName, ifName, mailSubject, exists As String
'here there will be some simple actions that extract sender-name and other words from the mail subject (some of these will represent the folder path where the mail will be moved)
'as a first check I verify if already exists a folder named as the sender (in the inbox folder):
CheckSender:
a = 1
Do Until a > objInboxFolder.folders.Count ' THIS IS THE FIRST BIG PROBLEM : THE COUNT IS MOST OF TIME ZERO AND VERY VERY RARELY TEN (THE TRUTH, AS I HAVE TEN FOLDERS IN THE INBOX)
' HERE I STOP COMMENTING: IT IS MANDATORY TO SOLVE THE ABOVE PROBLEM FOR ME BEFORE GOING ON ;-)
If objInboxFolder.folders.Item(a).Name = sendName Then GoTo CheckError
a = a + 1
Loop
GoTo CreateAll
CheckError:
MsgBox objInboxFolder.folders.Item(a).Name & " exists"
b = 1
Do Until b > objInboxFolder.folders.Item(a).Count
If objInboxFolder.folders.Item(a).folders.Item(b).Name = errorName Then GoTo CheckDevice
b = b + 1
Loop
GoTo CreateError
CheckDevice:
MsgBox objInboxFolder.folders.Item(a).folders.Item(b).Name & " exists"
c = 1
Do Until c > objInboxFolder.folders.Item(a).folders.Item(b).Count
If objInboxFolder.folders.Item(a).folders.Item(b).folders.Item(c).Name = deviceName Then GoTo CheckInterface
c = c + 1
Loop
GoTo CreateDevice
CheckInterface:
MsgBox objInboxFolder.folders.Item(a).folders.Item(b).folders.Item(c).Name & " exists"
d = 1
Do Until d > objInboxFolder.folders.Item(a).folders.Item(b).folders.Item(c).Count
If objInboxFolder.folders.Item(a).folders.Item(b).folders.Item(c).folders.Item (d).Name = ifName Then GoTo MoveMail
d = d + 1
Loop
CreateInterface:
' Set objProjectFolder = objInboxFolder.folders(sendName).folders(errorName).folders(deviceName).fol ders.Add(ifName)
GoTo MoveMail
CreateDevice:
' Set objProjectFolder = objInboxFolder.folders(sendName).folders(errorName).folders.Add(deviceName) .folders.Add(ifName)
GoTo MoveMail
CreateError:
' Set objProjectFolder = objInboxFolder.folders(sendName).folders.Add(errorName).folders.Add(deviceN ame).folders.Add(ifName)
GoTo MoveMail
CreateAll:
' Set objProjectFolder = objInboxFolder.folders.Add(sendName).folders.Add(errorName).folders.Add(dev iceName).folders.Add(ifName)
MoveMail:
MsgBox Item.Subject
End Sub
Thanks in advance
MaxFactor