Copy to folder - Outlook 2003

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,
I'm a newbie in Outlook programming with knowledge in VBA.
I need help in automating a process that will copy each arriving mail to a
specified folder according to the first name of the subject. if the folder
doesn't exist it should be created under the root folder.
Any suggestions?
Thanks in advance
 
Am Sun, 14 Aug 2005 00:57:02 -0700 schrieb Lp12:

hi,

you can trap the Inbox Items´ ItemAdd event which tells you if an item
is coming in.

The first word in subject can be extracted by Left and InStr functions.
Search with InStr for the first blank space and then get the characters
left from that point with the Left funtion.

Adding a folder depends on the folder type. Do you mean a folder in
Outlook or your file system?
 
Thanks a lot Micheal,
I mean copying a folder to my root inside Outlook tree.Search if one exists
and if not to create a new one.
Thanks again for all your help
 
Am Sun, 14 Aug 2005 01:24:01 -0700 schrieb Lp12:

Ok, sample:

Dim oFld as Outlook.Mapifolder
Set oFld=Application.Session.GetDefaultFolder(olFolderInbox)

If oFld.Folders("TestFolder") is Nothing Then
oFld.Folders.Add "TestFolder"
Endif
 
Dear Michael,

Ive started to write the Sub and i got lost trying to Set a mailitem to a
Folderitem:


Sub GetRootFolder()
Dim mpfRoot As Outlook.MAPIFolder
Dim mpf As Outlook.MAPIFolder
Dim idx As Integer
Dim Fileidx As Integer
Dim Subjectname As Variant
Dim SubjectnameFolder As MAPIFolder
Dim Subjectnamepoz As Long
Dim MyItem 'As Object
Dim CopyItem 'As Object
Set mpf = Application.Session.GetDefaultFolder(olFolderInbox)
Set mpfRoot = mpf.Parent
'External loop for each mail item in Inbox
For Fileidx = 1 To mpf.Items.Count
Set Subjectname = mpf.Items(Fileidx)
Set MyItem = mpf.Items(Fileidx)
Set CopyItem = MyItem.Copy
Subjectnamepoz = InStr(1, Subjectname, " ")
Subjectname = Left(Subjectname, Subjectnamepoz - 1)
Set SubjectnameFolder = Subjectname
'Internal loop to find/create the destination folder.
For idx = 1 To mpfRoot.Folders.Count
MsgBox mpfRoot.Folders.Item(idx).Name
If mpfRoot.Folders.Item(idx).Name = Subjectname Then
CopyItem.Move SubjectnameFolder
mpfRoot.Folders.Add Subjectname
End If
Next
Next
End Sub

I get an error of mistype (folder<> mail) but i get my desired name from the
subject of a mailitem and i want to copy it to a folderitem.
Can you please advice how to continue?
Thanks a lot
 
Am Sun, 14 Aug 2005 05:25:18 -0700 schrieb Lp12:

Wow :-)

You should learn something about the variable types. E.g. the Set
statement is for objects only, and you cannot set an object to a string.

Please compare my sample with yours:

Sub GetRootFolder()
Dim mpfRoot As Outlook.MAPIFolder
Dim mpf As Outlook.MAPIFolder
Dim idx As Integer
Dim Fileidx As Integer
Dim Subjectname As String
Dim SubjectnameFolder As MAPIFolder
Dim Subjectnamepoz As Long
Dim obj As Object
Dim MyItem As Outlook.MailItem
Dim CopyItem As Outlook.MailItem

Set mpf = Application.Session.GetDefaultFolder(olFolderInbox)
Set mpfRoot = mpf.Parent

'External loop for each mail item in Inbox
For Fileidx = 1 To mpf.Items.Count
Set obj = mpf.Items(Fileidx)
' Check the item´s type
If TypeOf obj Is Outlook.MailItem Then
'In this sample handle MailItems only.
Set MyItem = obj
Set CopyItem = MyItem.Copy
Subjectname = CopyItem.Subject
Subjectnamepoz = InStr(1, Subjectname, " ")
Subjectname = Left(Subjectname, Subjectnamepoz - 1)

' Check for the folder in a separate function because if it
doesn´t exist _
then my used method raises an error.
Set SubjectnameFolder = CheckForFolder(mpfRoot.Folders,
Subjectname)
If SubjectnameFolder Is Nothing Then
' Folder doesn´t exist. Create first then move item into
it.
Set SubjectnameFolder = mpfRoot.Folders.Add(Subjectname)
CopyItem.Move SubjectnameFolder
End If

' 'Internal loop to find/create the destination folder.
' For idx = 1 To mpfRoot.Folders.Count
' MsgBox mpfRoot.Folders.Item(idx).Name
' If mpfRoot.Folders.Item(idx).Name = Subjectname Then
' CopyItem.Move SubjectnameFolder
' mpfRoot.Folders.Add Subjectname
' End If
' Next
End If
Next
End Sub

Private Function CheckForFolder(colFolders As Outlook.Folders, _
sName As String) _
As Outlook.MAPIFolder
On Error Resume Next
Set CheckForFolder = colFolders(sName)
End Function
 
Michael... You're the man. :)
Thanks a lot. I understood your methodology and will use it in the future.
 
Back
Top