Search code examples
vbaemailoutlookdirectorymove

how do get this to work on the current viewing folder


I'm looking to get this to run for the current folder viewed when exploring and not cars folder tried a few things but no success.

Public Sub Move_Inbox_Emails_From_Excel()

Dim outApp As Object
Dim outNS As Object
Dim inboxFolder As Object
Dim destFolder As Object
Dim outEmail As Object
Dim inboxItems As Object
Dim i As Integer
Dim inputNumber As String
Dim numberToMove As Integer

inputNumber = InputBox("Enter number of emails to move")
On Error Resume Next
numberToMove = CInt(inputNumber)
On Error GoTo 0
If numberToMove < 1 Then Exit Sub

Set outApp = CreateObject("Outlook.Application")
Set outNS = outApp.GetNamespace("MAPI")
Set inboxFolder = outNS.GetDefaultFolder(olFolderInbox)
Set destFolder = inboxFolder.Parent.Folders("Car")             'Test folder at same level as Inbox

'Sort Inbox items by Received Time

Set inboxItems = inboxFolder.Items
'inboxItems.Sort "[ReceivedTime]", False     'ascending order (oldest first)
inboxItems.Sort "[ReceivedTime]", True      'descending order (newest first)

'Loop through sorted items for the number entered by the user, up to the number of items in the Inbox

For i = inboxFolder.Items.Count To inboxFolder.Items.Count - numberToMove + 1 Step -1
Set outEmail = inboxItems(i)
'Debug.Print i, outEmail.Subject
outEmail.Move destFolder
Next
End Sub

Solution

  • Replace the line

    Set destFolder = inboxFolder.Parent.Folders("Car")  
    

    with

    Set destFolder = outApp.ActiveExplorer.CurrentFolder