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

You can't:

http://support.microsoft.com/default.aspx?scid=kb;en-us;287778&Product=ol2002

archerslo is correct.
If your HTTP mail supports forwarding - that's the only option you'll have to accomplish what you're after...

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!

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.  

I don't see a way to forward these from hotmail.  It looks like macro coding will be the only way.

Actually it can be forwarded, but it costs a few dollars per month - http://www.email-forwarding.biz/hotmail/hotmail_faq_forward.html

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

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

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

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.

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

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.

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.

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

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

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!

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

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

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

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

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

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