Solved

How to move a message from inbox (HTTP account) to another folder as soon as it arrives?

Posted on 2004-04-17
24
1,616 Views
Last Modified: 2010-08-05
Basically I have 2 email accounts setup on Outlook 2002:
1. POP
2. HTTP account (hotmail)

The Rules Wizard allows me to create rules only pertaining to the messages in the POP e-mail account. I would like to, however, automatically move messages from my HTTP inbox to another folder as soon as it arrives/syncs. How do I do it?

Thank you.
0
Comment
Question by:newaira
  • 9
  • 6
  • 4
  • +3
24 Comments
 
LVL 6

Expert Comment

by:archerslo
ID: 10851494
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 10851544
archerslo is correct.
If your HTTP mail supports forwarding - that's the only option you'll have to accomplish what you're after...
0
 
LVL 3

Author Comment

by:newaira
ID: 10851649
But if you can do it with a click of a mouse i.e. dragging and dropping the message from one folder to another, there should be a way to do it with some sort of rule/macro. Hmmm, now macro is something that I just thought of! So there has to be a solution!
0
 
LVL 6

Expert Comment

by:archerslo
ID: 10852057
Go get 'em, tiger!  Happy coding!  ;)  Sometimes I too have a hard time believing that a Microsoft product isn't actually designed to do something that I think it obviously should.  
0
 
LVL 23

Expert Comment

by:slink9
ID: 10852739
I don't see a way to forward these from hotmail.  It looks like macro coding will be the only way.
0
 
LVL 23

Expert Comment

by:slink9
ID: 10852753
Actually it can be forwarded, but it costs a few dollars per month - http://www.email-forwarding.biz/hotmail/hotmail_faq_forward.html
0
 
LVL 3

Author Comment

by:newaira
ID: 10853849
OK, so this is what I came up with for the macros and it works! The part I don't know how to do is how to make it run automatically after I press Send/Receive.

Thank you.


Sub MoveToInbox()

 Dim ns As NameSpace               'Gives access to all Outlook's folders
 Dim HTTPInbox As MAPIFolder    'Email Inbox to move from
 Dim POPInbox As MAPIFolder      'Default Inbox to move to
 
 Set ns = GetNamespace("MAPI")              
 Set HTTPInbox = ns.Folders("asdf@asdf.com").Folders("Inbox") 'Set Email Inbox to move from
 Set POPInbox = ns.GetDefaultFolder(olFolderInbox)                   'Set Default Inbox to move to

 For Each Item In HTTPInbox.Items    'Move all items in Email Inbox to Default Inbox
    Item.Move POPInbox
 Next Item

End Sub
0
 
LVL 13

Expert Comment

by:stefri
ID: 10854519
Try this.... if we are lucky
Dim objNS as As NameSpace
 Dim POPInbox As MAPIFolder

Private WithEvents hotmailItems As Items

Function getStore(shdMbx)
Dim entryID As String
Dim storeID As String
Dim myFolders As Object
Dim myFolder As Object
Set myFolders = objNS.folders

For Each myFolder In myFolders
 

      If myFolder Is Nothing Then
          MsgBox "Cannot get first Folder object"
          set myFolders = nothing
          Exit Function
      End If
      If shdMbx = myFolder.Name Then
          Dim i As Integer
          For i = 1 To myFolder.folders.Count
              If myFolder.folders(i).Name = "Inbox" Then
                  entryID = myFolder.folders(i).entryID
                          storeID = myFolder.folders(i).storeID
                  Exit For
              End If
          Next
         Set getStore = objNS.GetFolderFromID(entryID, storeID)
         Set myFolders = nothing
         Exit Function
      End If
Next
 
End Function

Private Sub hotmailItems_ItemAdd(ByVal Item As Object)

      Item.Move POPInbox

End Sub

Private Sub Application_Startup()
  Dim myshared As Object
  Set objNS = Application.GetNamespace("MAPI")
  Set myshared = getStore("name of hotmail root folder") '<----------------- may be asdf@asdf.com ??????
  Set POPInbox = objNS.GetDefaultFolder(olFolderInbox)
  Set hotmailItems= myshared.Items

End Sub
Private Sub Application_Quit()
      Set objNS = Nothing
      Set myShared = Nothing
      Set hotmailItems = Nothing
      Set PopInbox = Nothing
End sub

Stefri
0
 
LVL 13

Expert Comment

by:stefri
ID: 10854535
Save, Quit OL to have Application_Startup initiated wwhen restarted OL or with VBA, focus on Set ObjNS= then F8 to end Sub

Backup your current ThisOutllokSession before modication ;-)

Stefri
0
 
LVL 23

Expert Comment

by:slink9
ID: 10854897
Stefri to the rescue!!!
By the way, I just put my finishing touches on a second round of editing on the book.  It is getting closer to completion.  I will send you a copy as soon as I have some to send out.
Anybody other than Stefri and Dreamboat should run out and buy LINK EM UP ON OUTLOOK in June.  It covers many aspects of Outlook from setup to macro programming.  As a matter of fact, one or two of the macros in the book are written by Stefri.
0
 
LVL 23

Expert Comment

by:slink9
ID: 10854938
Make that
Run out to Borders, Barnes And Noble, MicroCenter, or your local national bookseller to pick up a copy.  You can also order online at www.mrexcel.com
0
 
LVL 3

Author Comment

by:newaira
ID: 10855222
Thanks stefri, but I don't understand what your code is actually doing... I can see that you are moving some messages around, but that I was able to do myself. What I don't understand is how to have it execute automatically after Send/Receive is complete. If I can know that I could put it all together.

Thank you again.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 7

Expert Comment

by:rosesolutions1
ID: 10856353
Stefri's code is catching the email ariving into the hotmail inbox - thats from the 'withevents' and the carefully named hotmailItems_ItemAdd. Set hotmailItems= myshared.Items is the line that hooks them together.
 - Ie. it runs as each email arrives, not just once when you press F9.
0
 
LVL 13

Expert Comment

by:stefri
ID: 10857862
rosesolutions1
Thanks for providing the explanation during my sleeping time. I hope it will work and suit newaira's needs.

Slink9,
I have turned pinkish with your comments  ;-)

Stefri
0
 
LVL 3

Author Comment

by:newaira
ID: 10871459
Well I tried just copying and pasting the code, but the line "Private WithEvents hotmailItems As Items". It says something about WithEvents being valid only in object module.

Also I don't understand how to make it run as soon as Outlook is started. I am supposed to "focus on Set ObjNS= then F8 to end Sub", but I don't know what this means.

Sorry to be such a pain...
0
 
LVL 13

Assisted Solution

by:stefri
stefri earned 400 total points
ID: 10871509
No Prob
If you already have code in your ThisOutlookSeesion, the line Private.... MUST be before any declaration
If you set the Tools/Macro/Security to Medium, when you start OL, it displays a wrning to activate the Macro, click Yes

Upon starting, an event handler is installed to monitor hotmailItems
If you have set a Rule to run a script, there will be nothing to do
If my code works, whenever a mail arrives in the Hotmail folder, it will run the macro

'<----------------------------------- SNIP and paste to ThisOutlookSession

Private WithEvents hotmailItems As Items

Dim objNS as As NameSpace
Dim POPInbox As MAPIFolder

Function getStore(shdMbx)
Dim entryID As String
Dim storeID As String
Dim myFolders As Object
Dim myFolder As Object
Set myFolders = objNS.folders

For Each myFolder In myFolders
 

     If myFolder Is Nothing Then
         MsgBox "Cannot get first Folder object"
         set myFolders = nothing
         Exit Function
     End If
     If shdMbx = myFolder.Name Then
         Dim i As Integer
         For i = 1 To myFolder.folders.Count
             If myFolder.folders(i).Name = "Inbox" Then
                 entryID = myFolder.folders(i).entryID
                         storeID = myFolder.folders(i).storeID
                 Exit For
             End If
         Next
        Set getStore = objNS.GetFolderFromID(entryID, storeID)
        Set myFolders = nothing
        Exit Function
     End If
Next
 
End Function

Private Sub hotmailItems_ItemAdd(ByVal Item As Object)

     Item.Move POPInbox

End Sub

Private Sub Application_Startup()
  Dim myshared As Object
  Set objNS = Application.GetNamespace("MAPI")
  Set myshared = getStore("name of hotmail root folder") '<----------------- may be asdf@asdf.com ??????
  Set POPInbox = objNS.GetDefaultFolder(olFolderInbox)
  Set hotmailItems= myshared.Items

End Sub
Private Sub Application_Quit()
     Set objNS = Nothing
     Set myShared = Nothing
     Set hotmailItems = Nothing
     Set PopInbox = Nothing
End sub

Stefri
0
 
LVL 3

Author Comment

by:newaira
ID: 10874341
It worked in the beginning!, but then i started getting the "Run-time error '-2147221239(80040109): Method 'Move' of object 'MailItem' failed". When I click on debug and let it continue running it moves the message, so I don't know what is the problem.

Also how would I use this code for more the one HTTP e-mail address. I tried to sort of duplicate the code, but it didn't work.

Thanks a lot!
0
 
LVL 13

Expert Comment

by:stefri
ID: 10880776
Could send the code you have in your ThisOutlookSession. You may have lost the reference to POPAccount

For more than one account duplicate
Private WithEvents hotmailItems As Items
Private WithEvents anotherAccountItems As Items

Private Sub hotmailItems_ItemAdd(ByVal Item As Object)

     Item.Move POPInbox

End Sub

Private Sub anotherAccountItems_ItemAdd(ByVal Item As Object)

     Item.Move POPInbox

End Sub


Private Sub Application_Startup()
  Dim myshared As Object
  Dim mySharedA as Object

  Set objNS = Application.GetNamespace("MAPI")
  Set myshared = getStore("name of hotmail root folder") '<----------------- may be asdf@asdf.com ??????
  Set POPInbox = objNS.GetDefaultFolder(olFolderInbox)
  Set hotmailItems= myshared.Items

  Set mySharedA = getStore("another account folder")
  Set anotherAccountItems = mySharedA.Items

End Sub

Stefri
0
 
LVL 3

Author Comment

by:newaira
ID: 10882933
So this is what I have in my ThisOutlookSession, but I still get that error message...

Private WithEvents hotmailItems As Items
Private WithEvents anotherAccountItems As Items

Dim objNS As NameSpace
Dim POPInbox As MAPIFolder

Function getStore(shdMbx)
Dim entryID As String
Dim storeID As String
Dim myFolders As Object
Dim myFolder As Object
Set myFolders = objNS.Folders

For Each myFolder In myFolders
 
     If myFolder Is Nothing Then
         MsgBox "Cannot get first Folder object"
         Set myFolders = Nothing
         Exit Function
     End If
     If shdMbx = myFolder.Name Then
         Dim i As Integer
         For i = 1 To myFolder.Folders.Count
             If myFolder.Folders(i).Name = "Inbox" Then
                 entryID = myFolder.Folders(i).entryID
                         storeID = myFolder.Folders(i).storeID
                 Exit For
             End If
         Next
        Set getStore = objNS.GetFolderFromID(entryID, storeID)
        Set myFolders = Nothing
        Exit Function
     End If
Next
 
End Function

Private Sub hotmailItems_ItemAdd(ByVal Item As Object)

     Item.Move POPInbox

End Sub

Private Sub anotherAccountItems_ItemAdd(ByVal Item As Object)

     Item.Move POPInbox

End Sub


Private Sub Application_Startup()
  Dim myshared As Object
  Dim mySharedA As Object

  Set objNS = Application.GetNamespace("MAPI")
 
  Set myshared = getStore("asdf@hotmail.com")
  Set POPInbox = objNS.GetDefaultFolder(olFolderInbox)
  Set hotmailItems = myshared.Items

  Set mySharedA = getStore("asdf222@hotmail.com")
  Set anotherAccountItems = mySharedA.Items

End Sub

Private Sub Application_Quit()
     Set objNS = Nothing
     Set myshared = Nothing
     Set hotmailItems = Nothing
     Set POPInbox = Nothing
End Sub
0
 
LVL 13

Expert Comment

by:stefri
ID: 10883138
I am stuck!
It worked, did you say? What happened since this good old time?
Does it crash for every mail or for specifiy mails?

If the move Method crashes:
The item is invalid
You have set a rule which tries to process the item while our script is running

Try to add in the rule firing the macro: and STOP processing more rules

Slink9, rosesolution1,
Any spare time to join me?
Stefri

0
 
LVL 3

Author Comment

by:newaira
ID: 10883347
OK, I think I solved it (partially)! Basically what I thought was happening was that the message was being moved before it had fully arrived. So I added in a 1 second delay right before the "Item.Move POPInbox" line. The error does not show up anymore. The new issue is that if I get more then 1 message, only one message ends up being moved... How to solve this?

The extra code I have added:

Private Sub anotherAccountItems_ItemAdd(ByVal Item As Object)

     delay (1)
     Item.Move POPInbox

End Sub

Wherer delay is:
Private Sub delay(seconds As Long)
    Dim endTime As Date
   
    endTime = DateAdd("s", seconds, Now())
    Do While Now() < endTime
        DoEvents
    Loop
End Sub
0
 
LVL 7

Accepted Solution

by:
rosesolutions1 earned 50 total points
ID: 10884271
Ohhh - newaira figured it out, and I was all set to look so wise.  What is actually happening is that the start of the item arriving triggers the event, meanwhile the item keeps streaming in. There may be minor delays in the streaming based on what else the computer is doing, and an item with a large attachment would take awhile... I might set the delay to 5 seconds... (A particularly long one will get caught by the next tiem to come in - see below - so no big deal)

you need to change the move command to loop through all the items in the folder, not just the item that sent the event. The way Outlook works, other items can arrive while one is streaming in without the event firing again...

I suggest you update your cleanup code to set the new variables to nothing too.
0
 
LVL 3

Author Comment

by:newaira
ID: 10884543
Well I am glad that that is solved, but I still can't get it to move all the emails... I tried this code below, but it kept on copying the first e-mail over and over again, and never reaching the others that have arrived. What did I do wrong?

Private Sub hotmailItems_ItemAdd(ByVal Item As Object)

    Do While hotmailItems.Count <> 0
      delay (5)
      Item.Move POPInbox
    Loop
   
End Sub
0
 
LVL 3

Author Comment

by:newaira
ID: 10900720
OK, well I fixed this last part as well. This code seems to be working fine and I think I haven't overlooked anything. The delay could be increased if you are expecting larger e-mails, but this works fine for me. This code is for two HTTP e-mail address (hotmail1 and hotmail2).

Thank you Stefri
And thank you Rosesolutions1

Private WithEvents hotmail1 As Items
Private WithEvents hotmail2 As Items

Dim objNS As NameSpace
Dim POPInbox As MAPIFolder

Function getStore(shdMbx)
Dim entryID As String
Dim storeID As String
Dim myFolders As Object
Dim myFolder As Object
Set myFolders = objNS.Folders

For Each myFolder In myFolders
 
     If myFolder Is Nothing Then
         MsgBox "Cannot get first Folder object"
         Set myFolders = Nothing
         Exit Function
     End If
     If shdMbx = myFolder.Name Then
         Dim i As Integer
         For i = 1 To myFolder.Folders.Count
             If myFolder.Folders(i).Name = "Inbox" Then
                 entryID = myFolder.Folders(i).entryID
                         storeID = myFolder.Folders(i).storeID
                 Exit For
             End If
         Next
        Set getStore = objNS.GetFolderFromID(entryID, storeID)
        Set myFolders = Nothing
        Exit Function
     End If
Next
 
End Function

Private Sub hotmail1_ItemAdd(ByVal Item As Object)

    delay (5)

    Do While hotmail1.Count > 0
        hotmail1.Item(1).Move POPInbox
        delay (2)
    Loop
   
End Sub

Private Sub hotmail2_ItemAdd(ByVal Item As Object)

    delay (5)

    Do While hotmail2.Count > 0
        hotmail2.Item(1).Move POPInbox
        delay (2)
    Loop

End Sub

Private Sub Application_Startup()
    Dim myShared As Object
    Dim mySharedA As Object

    Set objNS = Application.GetNamespace("MAPI")
 
    Set myShared = getStore("newaira@hotmail.com")
    Set POPInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set hotmail1 = myShared.Items

    Set mySharedA = getStore("andrej_pavlovic@hotmail.com")
    Set hotmail2 = mySharedA.Items

End Sub

Private Sub Application_Quit()
     Set objNS = Nothing
     Set POPInbox = Nothing
     
     Set myShared = Nothing
     Set mySharedA = Nothing
     Set hotmail2 = Nothing
     Set hotmail1 = Nothing

End Sub

Function delay(seconds As Long)
    Dim endTime As Date
   
    endTime = DateAdd("s", seconds, Now())
    Do While Now() < endTime
        DoEvents
    Loop

End Function
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Use these top 10 tips to master the art of email signature design. Create an email signature design that will easily wow recipients, promote your brand and highlight your professionalism.
If you don't know how to downgrade, my instructions below should be helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now