HELP...Please...I am so a newby on the VB stuff.

I am trying to create a macro that will move messages from my Drafts folder
to another folder, based on specific words in the subject line.

For example: In my drafts file, a message with "HEALTH:" would be moved to
a unique folder called "Health Articles".

I would like the macro to run either as i save items intot the draft folder,
or is there a way to also create a menu "button" to run the macro
automatically.

Thanks for the help!

Am Thu, 8 Jun 2006 12:01:02 -0700 schrieb VBnovice:

For to start the code you can use the ItemAdd event of the Drafts folder. A
sample is available in the VBA help.

In that event check the Item´s Subject property with Instr. If it contains
what you´re looking for then call its Move function, which is also explained
in the help.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --


HELP...Please...I am so a newby on the VB stuff.

I am trying to create a macro that will move messages from my Drafts
folder
to another folder, based on specific words in the subject line.

For example: In my drafts file, a message with "HEALTH:" would be moved
to
a unique folder called "Health Articles".

I would like the macro to run either as i save items intot the draft
folder,
or is there a way to also create a menu "button" to run the macro
automatically.

Thanks for the help!

Michael - thanks for the start...but even that is above my head! I trided to
use the code provided from another post and modify it. Not my strong point.
Are there sources where i can just get an "add-in" or is there a source where
someone has already written the code that i can just copy and paste? I cant
imagine that i am doing somehting so unique - but i never know.

Any direction to a source where this is already done would be appreciated.
I just dont have the time right now to learn VBA...

"Michael Bauer" wrote:

Am Thu, 8 Jun 2006 12:01:02 -0700 schrieb VBnovice:

For to start the code you can use the ItemAdd event of the Drafts folder. A
sample is available in the VBA help.

In that event check the Item´s Subject property with Instr. If it contains
what you´re looking for then call its Move function, which is also explained
in the help.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --


HELP...Please...I am so a newby on the VB stuff.

I am trying to create a macro that will move messages from my Drafts
folder
to another folder, based on specific words in the subject line.

For example: In my drafts file, a message with "HEALTH:" would be moved
to
a unique folder called "Health Articles".

I would like the macro to run either as i save items intot the draft
folder,
or is there a way to also create a menu "button" to run the macro
automatically.

Thanks for the help!

Am Fri, 9 Jun 2006 04:49:01 -0700 schrieb VBnovice:

A good source for Add-ins is www.slipstick.com

If you google for "ItemAdd" in an Outlook programming newsgroup (e.g. this
one) there´re tons of samples.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --


Michael - thanks for the start...but even that is above my head! I trided
to
use the code provided from another post and modify it. Not my strong
point.
Are there sources where i can just get an "add-in" or is there a source
where
someone has already written the code that i can just copy and paste? I
cant
imagine that i am doing somehting so unique - but i never know.

Any direction to a source where this is already done would be appreciated.
I just dont have the time right now to learn VBA...

"Michael Bauer" wrote:

Am Thu, 8 Jun 2006 12:01:02 -0700 schrieb VBnovice:

For to start the code you can use the ItemAdd event of the Drafts folder.
A
sample is available in the VBA help.

In that event check the Item´s Subject property with Instr. If it
contains
what you´re looking for then call its Move function, which is also
explained
in the help.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.vbOffice.net --


HELP...Please...I am so a newby on the VB stuff.

I am trying to create a macro that will move messages from my Drafts
folder
to another folder, based on specific words in the subject line.

For example: In my drafts file, a message with "HEALTH:" would be moved
to
a unique folder called "Health Articles".

I would like the macro to run either as i save items intot the draft
folder,
or is there a way to also create a menu "button" to run the macro
automatically.

Thanks for the help!

Your original post item said that you would like to move messages from your
drafts folder, either:
(1) as you save them to the drafts folder; or
(2) by using a macro assigned to a menu.

This reply addresses the second part of your question.

The simple answer, as you no doubt guessed, is "yes" - you can create a
macro and assign it to a menu or a custom toolbar button.

However, you said your Drafts folder contained "messages". I'm not sure if
you mean "Mail Items" or "Post Items". As you may know, "Mail Items" are
emails you create to send to other people. "Post Items" are things you
create to store in a folder. If your intention is simply to store items in
a folder, perhaps it would be easier to open the topic folder and create a
Post Item in that folder. To do this, select the topic folder, then open
the File menu, and select New, Post in this Folder). On the other hand, it
may well be, as you say, that you need to store draft emails in a
categorised set of subfolders.

The macro below will move Mail Items or Post Items from the Drafts folder to
a set of subfolders.

To run the macro, it would be sensible to create a custom toolbar. Create a
custom button on the toolbar. Assign the public subprocedure below to the
custom button. If you need help with that, then post again to the
Newsgroup.

Here's the macro. I hope it will fit into this one post (if not I'll post a
second installment).

Create a new standard module and paste all the macro code below into the
module. (NB your original post is at the end.)

Read the notes (lines beginning with an apostrophe) to get some clues about
what's going on.

I hope you get time to study VBA in future. It's great fun!
Good luck
Geoff


Public Sub MoveItemsFromDraftsFolder()

' This subprocedure moves Mail or Post Items
' from the Drafts folder to Topic Subfolders.
' A Mail or Post Item is only moved if a
' predefined topic is found in the Item's
' subject.
'
' This subprocedure will create the Topic
' Subfolder if it does not exist (eg a folder
' for "Health Articles").

' The topic subfolder will be created in an
' "Articles" folder. The "Articles" folder will
' be the parent folder of the Topic Subfolders.
' The "Articles" folder will be created if it
' does not exist.
'
' The "Articles" folder will reside in the
' "Personal Folders" folder (ie in
' "Outlook Today - Personal Folders").


' Declare a string constant for each topic that
' may appear in the subject line and declare a
' corresponding string constant for the name of
' the folder where the Mail or Post Item should
' be moved to.

Const STRC_TOPIC1 As String = "HEALTH"
Const STRC_FOLDER1 As String = "Health Articles"

Const STRC_TOPIC2 As String = "SANITATION"
Const STRC_FOLDER2 As String = "Sanitation Articles"

Const STRC_TOPIC3 As String = "RADIOLOGY"
Const STRC_FOLDER3 As String = "Radiology Articles"

' Add further constants here for each topic and
' its corresponding Topic Subfolder.


' Declare object variables:
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objDRAFTS_FLDR As Outlook.MAPIFolder
Dim objROOT_FLDR As Outlook.MAPIFolder
Dim objSUB_FLDR As Outlook.MAPIFolder
Dim objO As Object

' Declare other variables:
Dim intRetVal As Integer
Dim blnFolderExists As Boolean
Dim blnRetVal As Boolean
Dim strMessage As String
Dim intButtons As Integer
Dim strHeading As String
Dim intMovedItemsCount As Integer


' Set up an error-handling routine:
On Error GoTo ErrorHandler

' Show message to user to confirm start:
strMessage = "Move Mail or Post Items in Drafts folder to topic
folders?"
intButtons = vbYesNo + vbQuestion + vbDefaultButton2
strHeading = "Confirm Start" & Space(50)
intRetVal = MsgBox(strMessage, intButtons, strHeading)
If intRetVal vbYes Then
strMessage = "Cancelled at your request."
intButtons = vbOKOnly + vbInformation
strHeading = "Finished" & Space(50)
MsgBox strMessage, intButtons, strHeading
GoTo Bye
End If

' Create instances of objects:
Set objOL = New Outlook.Application
Set objNS = objOL.GetNamespace("MAPI")

' Point to the drafts folder:
Set objDRAFTS_FLDR = objNS.GetDefaultFolder(olFolderDrafts)

' Point to the "Outlook Today - Personal Folders" folder:
Set objROOT_FLDR = objNS.Folders("Personal Folders")

' Point to the "Articles" subfolder:
Set objSUB_FLDR = GetMyFolder("Articles", objROOT_FLDR)

' Process each Mail or Post Item object
' in the drafts folder:
For Each objO In objDRAFTS_FLDR.Items
GoSub MoveNextItem
Next

' Show finished message:
If intMovedItemsCount = 1 Then
strMessage = "1 item was moved."
Else
strMessage = CStr(intMovedItemsCount) & " item(s) were moved."
End If
intButtons = vbOKOnly + vbInformation
strHeading = "Information" & Space(20)
MsgBox strMessage, intButtons, strHeading

Bye:

' Destroy object variables:
GoSub CleanUp

' Exit subprocedure he
Exit Sub

CleanUp:

Set objO = Nothing
Set objSUB_FLDR = Nothing
Set objROOT_FLDR = Nothing
Set objDRAFTS_FLDR = Nothing
Set objNS = Nothing
Set objOL = Nothing
Return

MoveNextItem:

' Call the "MoveIfFound" function for each
' topic in turn. Pass four arguments to the
' function so it can do its work:
' 1. The Mail or Post Item.
' 2. The topic to search for (eg "HEALTH").
' 3. The topic folder's parent folder
' (eg "Articles")
' 4. The name of the topic subfolder
' (eg "Health Articles").
' The "MoveIfFound" function returns TRUE or FALSE.
' Capture this Boolean value in the variable blnRetVal.
' If blnRetVal is TRUE, then the function moved
' the item, so increment the count of the number
' of moved items and return to the FOR-NEXT loop.


' Reset return value before each item
' is processed:
blnRetVal = False

' Check for first topic:
blnRetVal = MoveIfFound(objO, STRC_TOPIC1, objSUB_FLDR, STRC_FOLDER1)
If blnRetVal = True Then
intMovedItemsCount = intMovedItemsCount + 1
Return
End If

' Check for second topic:
blnRetVal = MoveIfFound(objO, STRC_TOPIC2, objSUB_FLDR, STRC_FOLDER2)
If blnRetVal = True Then
intMovedItemsCount = intMovedItemsCount + 1
Return
End If

' Check for third topic:
blnRetVal = MoveIfFound(objO, STRC_TOPIC3, objSUB_FLDR, STRC_FOLDER3)
If blnRetVal = True Then
intMovedItemsCount = intMovedItemsCount + 1
Return
End If

' If any more topics are to be checked, then
' ensure appropriate constants are declared at
' the top of this subprocedure and call the
' "MoveIfFound" function here, passing to it
' the appropriate arguments, eg:
'
' blnRetVal = MoveIfFound(objO, STRC_TOPIC4, objSUB_FLDR,
STRC_FOLDER4)
' If blnRetVal Then Return

Return

ErrorHandler:

MsgBox "Error No: " & CStr(Err.Number) _
& vbNewLine & vbNewLine _
& Err.Description, vbOKOnly + vbExclamation, "Error"
Resume Bye

End Sub

Private Function GetMyFolder( _
strSubFolderName As String, _
objPARENT_FLDR As Outlook.MAPIFolder) As Outlook.MAPIFolder

' PURPOSE OF FUNCTION:
'
' This function checks to see if a subfolder
' exists within a folder. If the subfolder exists,
' then this function returns a reference to the
' subfolder. If the subfolder does not exist,
' then this function creates the subfolder and
' returns a reference to the subfolder.
'
' IN:
'
' strSubFolderName:
' The name of the subfolder.
'
' objPARENT_FLDR:
' The folder in which the subfolder needs
' to exist.

Dim objSUBFLDR As Outlook.MAPIFolder
Dim blnSubFolderExists As Boolean

' Assume subfolder does not exist:
blnSubFolderExists = False

' Iterate through the Folders collection of
' the parent folder to see if subfolder exists:
For Each objSUBFLDR In objPARENT_FLDR.Folders
If objSUBFLDR.Name = strSubFolderName Then
blnSubFolderExists = True
Exit For
End If
Next

' If subfolder does not exist, then create it:
If blnSubFolderExists = False Then
Set objSUBFLDR = objPARENT_FLDR.Folders.Add(strSubFolderName)
End If

Bye:

' Set this function's return value:
Set GetMyFolder = objSUBFLDR

' Destroy object variable:
GoSub CleanUp

Exit Function

CleanUp:

Set objSUBFLDR = Nothing
Return

End Function

Private Function MoveIfFound( _
objITEM As Object, _
strTopicToFind As String, _
objPARENT_FLDR As Outlook.MAPIFolder, _
strTopic_Fldr_Name As String) As Boolean

' PURPOSE OF FUNCTION:
'
' This function moves a Mail or Post Item
' to a topic subfolder if the item's subject
' contains the topic.
'
' IN:
'
' objITEM:
' The Mail or Post Item to be moved
' if the topic is found in the subject.
'
' strTopicToFind:
' The topic (eg "HEALTH") to find in
' the item's subject.
'
' objPARENT_FLDR:
' The folder that contains the topic
' subfolder.
'
' strTopic_Fldr_Name:
' The name of the topic folder,
' (eg "Health Articles").
'
' THIS BOOLEAN FUNCTION RETURNS:
'
' TRUE if the item is moved.
' FALSE if the item is not moved.


' Declare object variables:
Dim objTOPIC_FLDR As Outlook.MAPIFolder

' Declare other variables:
Dim RetVal As Boolean
Dim strSubject As String
Dim lngTopicFoundAtChar As Long
Dim blnTopicFolderExists As Boolean


' Store function's default return value:
RetVal = False

' Only proceed if the incoming object
' is a Mail Item or a Post Item:
On Error Resume Next
If objITEM.Class = olMail Then GoTo CheckSubject
If objITEM.Class = olPost Then GoTo CheckSubject

' Otherwise, just exit function.

Bye:

' Destroy object variable:
GoSub CleanUp

' Set this function's return value:
MoveIfFound = RetVal

' Exit function he
Exit Function

CleanUp:

Set objTOPIC_FLDR = Nothing
Return

CheckSubject:

' Reset error handler:
On Error GoTo 0

' Get subject:
strSubject = objITEM.Subject

' See if topic is found in subject;
' Ignore case by using vbTextCompa
lngTopicFoundAtChar = InStr(1, strSubject, strTopicToFind,
vbTextCompare)

' If found, carry on:
If lngTopicFoundAtChar 0 Then GoTo MoveItem

' Otherwise, just exit function:
GoTo Bye

MoveItem:

' Point to the topic subfolder:
Set objTOPIC_FLDR = GetMyFolder(strTopic_Fldr_Name, objPARENT_FLDR)

' Move the Mail or Post Item:
objITEM.Move objTOPIC_FLDR

' We've moved the item, so this function's
' return value is TRUE:
RetVal = True

' Exit function:
GoTo Bye

End Function






"VBnovice" wrote in message
...
HELP...Please...I am so a newby on the VB stuff.

I am trying to create a macro that will move messages from my Drafts
folder
to another folder, based on specific words in the subject line.

For example: In my drafts file, a message with "HEALTH:" would be moved
to
a unique folder called "Health Articles".

I would like the macro to run either as i save items intot the draft
folder,
or is there a way to also create a menu "button" to run the macro
automatically.

Thanks for the help!