Moving Email to Folder Depending on content

[Suggy1982]

I have the following code in an Access VBA module, which loops through each
email in a specified email folder and then parse's out certain data items and
imports them into an access DB, which works fine.

The bit i am struggling with is after that. I want the code to then move the
email into a folder depending on one of the data items in the email.

I am not sure if i have DIM'd the target folder correctly, can anyone else?

Thanks

Adrian

CODE:

Sub Checkmail()

Dim o_Out_Items As items
Dim DestFolderPath As Outlook.MAPIFolder
Dim o_Item As Variant
Dim o_items As MailItem
Dim strmailbod As String
Dim toname As String
Dim myRecipient As Outlook.Recipient
Dim destfolder As Folders


Set myRecipient =
CreateObject("Outlook.Application").GetNamespace("MAPI").CreateRecipient("(e-mail address removed)")


'Import from
Set o_Out_Items = CreateObject("Outlook.Application") _
.GetNamespace("MAPI") _
.GetSharedDefaultFolder(myRecipient,
olFolderInbox).items

Set DestFolderPath = CreateObject("Outlook.Application") _
.GetNamespace("MAPI") _
.GetSharedDefaultFolder(myRecipient,
olFolderInbox) _
.destfolder

For Each o_Item In o_Out_Items
isithelpdesk = 0

'MsgBox o_Item.Subject
toname = o_Item.SenderName
'MsgBox toname


ssub = ""
scolleaguename = ""
sdepartment = ""
sextension = ""
sbigbox = ""
stype = ""
ssectionref = ""
swholesection = ""
slegal = ""
sitem = ""
scurrent = ""
sproposed = ""
sdatelaunched = ""


strmailbod = InvChars(o_Item.body)
ssub = o_Item.Subject

If ssub = "Big Box and Retail Rules & Standards Update" Then
isithelpdesk = 1
If InStr(1, strmailbod, "Colleague Name:
") > 0 Then
scolleaguename = ParseOrderDetails("Colleague
Name: ", strmailbod)
End If

If InStr(1, strmailbod, "Department: ")

0 Then

sdepartment = ParseOrderDetails("Department: ",
strmailbod)
End If

If InStr(1, strmailbod, "Extension: ")

0 Then

sextension = ParseOrderDetails("Extension: ",
strmailbod)
End If

If InStr(1, strmailbod, "Big Box: ") >
0 Then
sbigbox = ParseOrderDetails("Big Box: ",
strmailbod)
End If

If InStr(1, strmailbod, "Type: ") > 0
Then
stype = ParseOrderDetails("Type: ", strmailbod)
End If

If InStr(1, strmailbod, "SectionRef: ")

0 Then

ssectionref = ParseOrderDetails("SectionRef: ",
strmailbod)
End If

If InStr(1, strmailbod, "Whole Section:
") > 0 Then
swholesection = ParseOrderDetails("Whole
Section: ", strmailbod)
End If

If InStr(1, strmailbod, "Legal: ") > 0
Then
slegal = ParseOrderDetails("Legal: ", strmailbod)
End If

If InStr(1, strmailbod, "Item: ") > 0
Then
sitem = ParseOrderDetails("Item: ", strmailbod)
End If

If InStr(1, strmailbod, "Current: ") >
0 Then
scurrent = ParseOrderDetails("Current: ",
strmailbod)
End If

If InStr(1, strmailbod, "Proposed: ") >
0 Then
sproposed = ParseOrderDetails("Proposed: ",
strmailbod)
End If

If InStr(1, strmailbod, "Date Launched:
") > 0 Then
sdatelaunched = ParseOrderDetails("Date
Launched: ", strmailbod)
End If


Set o_rs = CurrentDb.OpenRecordset("Select *
From t_Updates")
With o_rs
.AddNew
!ColleagueName = scolleaguename
!Department = sdepartment
!ContactNumber = sextension
!BigBox = sbigbox
!PolicyHowTo = stype
!SectionReference = ssectionref
!WholeSectionChange = swholesection
!LegislationLegalChange = slegal
!Item = sitem
!CurrentWording = scurrent
!ProposedWording = sproposed
!DateLaunchedToChain = sdatelaunched
.Update
.Close
End With
Set o_rs = Nothing

Else
End If


If sbigbox = "xxx" Then
Set destfolder = folder1

Else
End If

If sbigbox = "yyy" Then
Set destfolder = folder2

Else
End If


If isithelpdesk = 1 Then
o_Item.UnRead = False
o_Item.Move DestFolderPath
Set DestFolderPath = Nothing
Else
End If

Next

End Sub

 

[Ken Slovak - [MVP - Outlook]]

That's some really ugly code.

Declare Outlook.Application and NameSpace objects and only assign them once,
then use them again. Don't keep using CreateObject().

You cannot assign DestFolderPath (MAPIFolder) to a Folders collection, which
is what you're trying to do. You can assign it to a MAPIFolder only. You
also use destfolder without ever assigning it to anything. I think what
you're trying to do should look something like this:

Dim o_Item As Object
Dim o_items As Outlook.Items
Dim oApp As Outlook.Application
Dim oNS As Outlook.NameSpace

Set oApp = CreateObject("Outlook.Application")
Set oNS = oApp.GetNameSpace("MAPI")

Set myRecipient = oNS.CreateRecipient("(e-mail address removed)")

'Import from
Set o_Out_Items = oNS.GetSharedDefaultFolder(myRecipient,
olFolderInbox).Items

Set destfolder = oNS.GetSharedDefaultFolder(myRecipient,
olFolderInbox).Folders

It's hard to tell from the rest of the code, but I think you need to set
DestFolderPath to either folder1 or folder2, but you don't declare folder1
or folder2 and you never assign them to anything, so I have no idea what
those are.

Also, when moving/deleting items from a collection never use a For or
For...Each loop. Use a count down For loop:

Dim i As Long

For i = o_Out_Items.Count To 1 Step -1
Set o_Item = o_Out_Items.Item(i)

If I were you I'd also check for o_Item.Class = olMail before trying to get
email properties from the item, it could be a Post item or some other type
of item.

 

[Suggy1982]

Thanks for the reply and the pointers regarding my code, I will tidy it up.

The middle part of the code is what parse out the data from the email item
and inserts it into an access DB; this bit is working fine so I won't touch
that (for the time being)

Basically what I want to get is:-

In my inbox I have a number of folders e.g. folder 1, folder 2, folder 3

And depending on a particular data item in the email, i want to move to
email into a one of those folders.

Can I declare a variable and tag this into the end of the destfolder or do I
have to declare each folder (folder 1, folder 2, folder 3) separately?

Sorry if I am making this confusing.

 

[Ken Slovak - [MVP - Outlook]]

To avoid confusion and to make the code easier to maintain I would declare a
specific MAPIFolder object for each subfolder of Inbox.

Dim folder1 As Outlook.MAPIFolder ' etc.

Set destfolder = oNS.GetSharedDefaultFolder(myRecipient,
olFolderInbox).Folders
Set folder1 = destfolder.Item("folder 1") ' etc., make sure to exactly
match the name

Then when you get the value that determines where to move the item you'd use
one of those predefined MAPIFolder objects as the target folder.

If you intend to persist the UnRead state you will need to save the item.
Also, Move() is a function that returns a new item object, so I'd be
declaring a MailItem object and assigning that as the Move() return value.

 

[Suggy1982]

Thanks for your help again.

One final question,

When you set the folder name in 'Set folder', would it not be possible to
make the folder name a variable so that you could then set the folder name
using an if.

e.g. (I know this isn't coded correctly, I am just trying to demonstrate the
theory)

--
Dim folder1 As Outlook.MAPIFolder ' etc.

Set destfolder = oNS.GetSharedDefaultFolder(myRecipient,
olFolderInbox).Folders
Set folder = destfolder.Item(FolderName)

if x = A set FolderName = folder1
if x = B send FolderName = folder2

x.move destfolder.folder
--
Thanks

Adrian

 

[Ken Slovak - [MVP - Outlook]]

You can use a string variable instead of using a string constant for that,
yes.