[RESOLVED] moving mail from sub folder to personal folder

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!

VB Code:

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.

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 ???

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

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. ;)

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.

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?

test1 = Inbox\test1
test2 = Personal Folders\test2

Outlook 2000 and yes its in an exchange server environment

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?

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

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.

VB Code:

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

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

it seems that my personal folders are on a shared drive

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.

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

What line?

doesnt say?!?
am i being stupid??

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

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. ;)

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

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

VB Code:

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. :D

ohhh impressive! lol easily pleased! yup that works

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

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

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?

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?

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.

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

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.

VB Code:

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

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.

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

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

oEmail.Move oTest2

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

Can you post your current code?

VB Code:

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

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.

VB Code:

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

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

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.

VB Code:

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

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

thanks once again :)

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

VB Code:

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

oops i get array of index out of bounds error :(

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

VB Code:

Set oEmail = oTest1.Items.Item(i)

You my friend are an absolute star! ty very much for your time and effort!
Hope you have a great xmas!

now just gotta get it working with the other code! lol

Marked the threas as resolved but found another problem. the first time the script runs it give me an array out of bounds error. if i run it again it works????

Your welcome :)

Easiest way to determine whats happening and which line is giving the error is to step through the code. Place a breakpoint on the Private Sub part then run and when it breaks press F8 for line by line execution and see where the issue lies.

ok thanks! is there any reason why only one macro will run?? i have the attachment macro and it seems to ognore that one and just move the mail???

I guess it would depend on how its supposed to be invoked. Which is the starting point? GetFolder? I'm not sure what all your code looks like now. Are you still using any of the Rules for this?

ok do you want me to post all my code?

the rule is still running! dont know where to start with coding that if i need to

Sure but did you modify your rule to include any new code execution? How are you expecting to execute the code?

here it is

VB Code:

Private Sub Application_NewMail()
SaveAttachmentsToFolder
End Sub
 
Sub SaveAttachmentsToFolder()
  On Error GoTo SaveAttachmentsToFolder_err
  Dim ns As NameSpace
  Dim Inbox As MAPIFolder
  Dim SubFolder As MAPIFolder
  Dim Item As Object
  Dim Atmt As attachment
  Dim FileName As String
  Dim i As Integer
  Dim varResponse As VbMsgBoxResult
  Set ns = GetNamespace("MAPI")
  Set Inbox = ns.GetDefaultFolder(olFolderInbox)
  Set SubFolder = Inbox.Folders("test1") ' Enter correct subfolder name.
  i = 0
  For Each Item In SubFolder.Items
    For Each Atmt In Item.Attachments
      If Right(Atmt.FileName, 1) = "Z" Then
        FileName = "C:\Documents and Settings\Desktop\Attachments\" & _
        Atmt.FileName
        Atmt.SaveAsFile FileName
        i = i + 1
      End If
    Next Atmt
  Next Item
SaveAttachmentsToFolder_exit:
  Set Atmt = Nothing
  Set Item = Nothing
  Set ns = Nothing
  Exit Sub
SaveAttachmentsToFolder_err:
  MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
  Resume SaveAttachmentsToFolder_exit
 
End Sub
 
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 Outlook.MailItem
Dim i As Integer
For i = 1 To oTest1.Items.Count
    Set oEmail = oTest1.Items.Item(i)
    oEmail.Move oTest2
    Set oEmail = Nothing
Next
End Sub

the rule runs, then the code executes from a new mail

Ok, you have the original code running from when a new mail arrives. Then you have this part from my example in a new sub that is not being called from anyware.

Private Sub Form_Load()

The code in the procedure should be called from your SaveAttachmentsToFolder procedure after it saves all attachments. Try changing Form_Load to MoveMails I guess. Then call MoveMails from your SaveAttachmentsToFolder and it should be all good.

here is the rule
[IMG]http://i28.photobucket.com/albums/c2...sback/rule.jpg

Seems the chain of events may be wrong.

You NewMail event procedure runs first, the the rule runs, then the vba code runs.

probably should be Rule runs, calls the SaveAttachments vba code, then that procedure calls the MoveMe code.

nope just made the change u suggested and it all works! RobDog you are the Outlook guru! thankyou so much

Thanks :D That is what I call myself when I work on Outlook threads. Its my forte! I got into the other office apps and soon changed my signature to VB/Office Guru™ :D

Glad to have helped you solve this issue and have a Merry Xmas :thumb: