[RESOLVED] moving mail from sub folder to personal folder

[fox 2]

Hi there, I am a complete novice to coding and have been trying to construct a piece of code from other bits i have got for Outlook 2000

I have a rule that moves specific new mail from the inbox to a subfolder and a macro extracts the attachment. This all works great, but now is where the new code comes in! I need the mail in the sub folder to then be moved to a personal folder. As far as i can see rules don't work on subfolders and i've been playing with code and realised i need to declare my own function to get to the personal folder.

Here is what i have, i can not work out how to adapt the getfolder function to my needs. running as it is i get errors. I'm at that point where i feel like throwing in the towel, i just can't get my head around it! its probably really simple!

Public Function GetFolder(strFolderPath As String) As MAPIFolder
  ' folder path needs to be something like
  '   "Public Folders\All Public Folders\Company\Sales"
  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next
 
  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")
  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set objFolder = objNS.Folders.Item(arrFolders(0))
  If Not objFolder Is Nothing Then
    For I = 1 To UBound(arrFolders)
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(I))
      If objFolder Is Nothing Then
        Exit For
      End If
    Next
  End If
 
  Set GetFolder = objFolder
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing
End Function
 
Sub MoveItems()
 
Dim myolAPP As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myInputFolder As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Set myNameSpace = myolAPP.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myInputFolder = myInbox.Folders("test1")
Set myDestFolder = GetFolder("Personal Folders\test2")
Set myItems = myInputFolder.Items
myItems.Move myDestFolder
 
End Sub

Many thanks for any help.

[RobDog888]

Welcome to the Forums.

You should create a Item_Add event for your sbfolder so when the rule runs and moves the item into it it will trigger the event and move the item to your personal folder, which I assume is in another pst file. If so then you need to use the AddStore method to attach the other pst to your session. Then you can navigate to it and move the item into your desired folder. Then maybe parse the attachment or ???

[fox 2]

thanks for the reply, sounds like it's getting rather complicated, think it's above me now

[RobDog888]

I'll try to walk you through it. Give us a simple example and how it is to be handled. Give details if its in the same pst file or different, etc.

[fox 2]

hi thanks again

the folder where the mail is moved to by the rule is a subfolder of the Inbox called "test1" This rule works fine.
A nice bit of code extracts the attachment and saves it on a local drive. this bit works fine.

Now i want to move the mail in "test1" (the subfolder of inbox) to a personal folder called "test2". Now because this is not a default folder i know i need to use something like the GetFolder method in my forst post, but i just can't seem to get it working.

[RobDog888]

Ok, what is the full path of "test2"?
"test1" is probably something like - "Personal Folders\Inbox\test1".

Is "test2" under the same "Personal Folders" or a different one? Are you running Outlook in an Exchange server enviroment?

[fox 2]

test1 = Inbox\test1
test2 = Personal Folders\test2

Outlook 2000 and yes its in an exchange server environment

[RobDog888]

Ok so Inbox\test1 is your Exchange folder saved on your exchange server. Then the Personal Folders is a local pst file that is already added to your Outlooks session or do we need to add it?

[fox 2]

test2 already exists and is there every time i start outlook (if that helps???)

[RobDog888]

Yes, it does. Now what you need to do is figure out how to know when to run the code to move the test1 emails?

We can use the AddStore if the pst is not added but this is how to attach to your test2 folder.

Private Sub Form_Load()
    Dim oApp As Outlook.Application
    Dim oTest1 As Outlook.MAPIFolder
    Dim oTest2 As Outlook.MAPIFolder
    Set oApp = New Outlook.Application
    Set oTest1 = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("test1")
    'In case the pst is not added then this line:
    'oApp.GetNamespace("MAPI").Session.AddStore ("C:\Documents and Settings\Outlook\MyStore.pst")
    Set oTest2 = oApp.GetNamespace("MAPI").Folders("Personal Folders").Folders("test2")
End Sub

[fox 2]

the location that you specify the add store, is that a common location or will i need to specify the correct path on my pc?

thanks once again

[fox 2]

it seems that my personal folders are on a shared drive

[RobDog888]

Thats ok as long as you have permissions to it and its available. Just make sur the "Personal Folders" is reflected as it shows in your Outlook session. If you added it and pointed it to the shared drive then it should be ok, just maybe a bit slower from the network.

[fox 2]

ok thats done but i get object doesn't support this property or method when i run it

[RobDog888]

What line?

[fox 2]

doesnt say?!?
am i being stupid??

shall i take out the bits of code i have done (the ones in the first post)?

[RobDog888]

Oh, just try my code in a new test project and add a reference to Outlook. Once we get that working then we can integrate it into your code.

[fox 2]

ok done. no errors but i dont see it doing anything, is this right?

[RobDog888]

Yes, that is true but at least no errors. Add these lines to the end of my code before the End Sub.

Dim oEmail As Outlook.MailItem
    Set oEmail = oApp.CreateItem(olMailItem)
    oEmail.Move oTest2

After you run it you should see a new blank email message in the test2 folder. Then it wil be working correctly.

[fox 2]

ohhh impressive! lol easily pleased! yup that works

[RobDog888]

The rest will be just integrating the code logic into your previous code. But how will it know when to run if your doing actions on an item from the rule? Are you going to make this run from a button click or something?

Sorry but I got to get back to sleep. Almost 4 am. I'll be back tomorrow and will check it out if no one else can help finish the integration.

Later

[fox 2]

it runs constantly from new mail so hoping that it will pick it up when it hits test1? if this is possible?

You are a star! thats such a big help i've been trying to get half this far for over a week!

ty so much

[RobDog888]

Still here. I think you may get into trouble if the rule is running parsing the attachment and then this code runs to move the item. Couldnt you add this from your existing rule maybe?

[fox 2]

is there a run script part to a rule? or would i need to make my own rule up in vba and let the whole thing run in one block of code when a new mail arrives?

[RobDog888]

You can do it all from VBA code like I wrote. You would create an Item_Add event so when you recieve a new email you can test for if you should move it and do your parsing, moving et. But there is a run scrit otpion in a rule but its for a script file I believe. I dont use rules, only vba code so I am not 100% sure.

[fox 2]

ok i'll take a look and let u know! many thanks
Now get some sleep!

[fox 2]

right i changed a couple of lines and this looked right but every time i run it i get object doesn't support property or method error!

if this bit works i can add it to my other code and try running the whole lot.

Private Sub Form_Load()
    Dim oApp As Outlook.Application
    Dim oTest1 As Outlook.MAPIFolder
    Dim oTest2 As Outlook.MAPIFolder
    Set oApp = New Outlook.Application
    Set oTest1 = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("test1")
    'In case the pst is not added then this line:
    'oApp.GetNamespace("MAPI").Session.AddStore ("C:\")
    Set oTest2 = oApp.GetNamespace("MAPI").Folders("Personal Folders").Folders("test2")
    Dim oEmail As Object
    Set oEmail = oTest1.Items
    oEmail.Move oTest2
End Sub

Thanks in advance

[RobDog888]

Place a breakpoint on the procedures "Private Sub" line. Then press F8 to step through the code. Tell me which line is generating the error. I am running Outlook 2003 and maybe there is a prop or method that is not in Outlook 2000.

[fox 2]

everyline seems ok apart from when i get to the end and i press f8 for the lst time so it should jump to end Sub but it gives me the error message

[RobDog888]

What was the error message? So is this line executing correct and moving the email?

oEmail.Move oTest2

[fox 2]

Yes that line seems fine it's not moving the mail but no errors!

the error is = runtime error438 object doesn't support this method or property

[RobDog888]

Can you post your current code?

[fox 2]

Private Sub Form_Load()
    Dim oApp As Outlook.Application
    Dim oTest1 As Outlook.MAPIFolder
    Dim oTest2 As Outlook.MAPIFolder
    Set oApp = New Outlook.Application
    Set oTest1 = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("test1")
    'In case the pst is not added then this line:
    'oApp.GetNamespace("MAPI").Session.AddStore ("C:\")
    Set oTest2 = oApp.GetNamespace("MAPI").Folders("Personal Folders").Folders("test2")
    Dim oEmail As Object
    Set oEmail = oTest1.Items
    oEmail.Move oTest2
End Sub

[RobDog888]

Ok, I see whats happoening here. You didnt add the second line of code that I gave you to create the email object. These are the lines of importance.

Dim oEmail As Outlook.MailItem
    Set oEmail = oApp.CreateItem(olMailItem)
    oEmail.Move oTest2

[fox 2]

sorry but are we at cross purposes?? lol
it's not a new mail im trying to create but move existing new mail from test1 to test2
i thought the create mail bit just created a blank mail

[RobDog888]

Oh, thats right. Then we need to "find" the email in question in the test1 folder and set oEmail = to it. then the move will work.

Dim oEmail As Outlook.MailItem
Set oEmail = oTest1.Items(oTest1.Items.Count)' Will work if your desired email is the last one in the list, sorted by date/time received 
oEmail.Move oTest2

[fox 2]

ok so what if i want to move all mail from test1 to test2?
lol getting complicated!

thanks once again

[RobDog888]

Oh, that actually makes things easier. This is not hard at all after you see whats going on.

Dim oEmail As Outlook.MailItem
Dim i As Integer
For i = 1 To oTest1.Items.Count
    Set oEmail = oTest1.Items(i)
    oEmail.Move oTest2
    Set oEmail = Nothing
Next

[fox 2]

oops i get array of index out of bounds error

[RobDog888]

Sorry, I have been typing directly into the reply box. I doublechecked the code in the VB IDE and it should be...

Set oEmail = oTest1.Items.Item(i)