Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 11-20-2005, 10:04 PM
Microchip Microchip is offline
Novice
Microsoft Outlook Movemail
 
Join Date: Nov 2005
Location: Indiana
Posts: 5
Microchip is on a distinguished road
Exclamation Microsoft Outlook Movemail

I am trying to write an Outlook program to move mail to a specific folder based on text in the subject, or anything else.

The program can move mail from the Inbox to a subfolder of Inbox, but I can't for the life of me figure out how to make it go to a folder called "Confirmed", which is NOT a subfolder of Inbox.

Any help would be greatly appreciated!

Here is the source code:
Option Explicit
Sub Analyze()
' This program will analyze the Outlook Inbox
On Error GoTo Analyze_Err
' The NameSpace is the object that gives you access to all of Outlook's Folders.
' In Outlook, there is only one, and it is called "MAPI", which
' is an acronym for Messaging Application Programming Interface.
Dim ns As NameSpace
Dim CurrentMailItem As MailItem
' We are going to refer to a mail folder (a MAPIFolder object)
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment ' The attachment objects we will be looking for
Dim FileName As String ' Name and save path for each attachment
Dim a As Integer ' Number of attachments found
Dim i As Integer ' Number of items in the Inbox
Dim m As Integer ' Number of items moved
Dim strMsg As String
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
a = 0 ' Init the number of attachments
i = 0 ' Init the number of items
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
' The Inbox does indeed contain something.
For Each Item In Inbox.Items
i = i + 1
For Each Atmt In Item.Attachments
a = a + 1
Next Atmt
strMsg = ""
If InStr(1, Item.Subject, "SR", vbTextCompare) Then
strMsg = strMsg & "This item pertains to an SR." & vbCrLf
strMsg = strMsg & "Subject: " & Item.Subject & vbCrLf
If MoveMail(Item, Inbox.Folders.Item("Processed").EntryID) Then
m = m + 1


strMsg = strMsg & "Item was moved!" & vbCrLf
Else
strMsg = strMsg & "The message was not moved!" & vbCrLf
End If
MsgBox strMsg, vbInformation, "Item #" & Str(i) & " Info"
End If
Next Item
strMsg = "I found " & i & " items in your Inbox." & vbCrLf
strMsg = strMsg & _
"I moved " & m & " files." & vbCrLf
MsgBox strMsg, vbInformation, "Finished!"
Analyze_Exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

Analyze_Err:
MsgBox "An unexpected error has occurred." & vbCrLf & _
"Please note and report the following information." & vbCrLf & _
"Macro name: Analyze" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf _
, vbCritical, "Error!"
Resume Analyze_Exit
Exit Sub
End Sub

Private Function MoveMail(CurrentMailItem As MailItem, strTargFldrID As String) As Boolean
Dim CurrentNameSpace As NameSpace
Dim CurrentMoveMailItem As MailItem
Set CurrentNameSpace = Application.GetNamespace("MAPI")
On Error GoTo FINISH:
Set CurrentMoveMailItem = CurrentMailItem.Copy
CurrentMoveMailItem.Move _
DestFldr:=CurrentNameSpace.GetFolderFromID(strTarg FldrID)
'CurrMailItem.Delete
Err.Number = True
FINISH:
MoveMail = CBool(Err.Number)
End Function
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Microsoft Licensing LizzyRut Office 0 10-14-2008 02:19 PM
Microsoft calendar 6 pljames Misc 0 05-31-2008 05:33 PM
Microsoft Outlook Movemail Microsoft Outlook 2000 Problem Wiily Outlook 1 04-14-2006 02:06 AM
Microsoft Outlook Movemail Microsoft Outlook Slow to Task Mgr peak100% MICH Office 2 11-27-2005 03:36 AM
Microsoft Outlook Movemail Microsoft Frontpage sufi Office 2 10-29-2005 07:56 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:02 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft