Microsoft Office Forums - View Single Post - [Solved] Move emails from one folder to another

smiler44 · 11-12-2014, 01:39 PM

I'm using outlook 2010 and 2007 so please can you tell me if your advice is specific to either version, thank you

I want to move emails from one folder to another by a macro. I have searched the internet and found a couple of ideas but can not make them work. I also need to search the subject line for a "string" that starts "abcd" and then is followed by 6 digits, so I'm looking for something that looks like this abcd123456

The folder I want to move the email too will vary so for now could we assume I want to move an email to either the Drafts or Deleted folder from my inbox?

I think this code below that I found on the internet proves that my understanding of the path is correct. The Inbox or Drafts folder is momentarily displayed. there is a second lot of code below this.

Code:

Sub TestGetFolder()
 Dim folder As Outlook.folder
 
 'Set folder = GetFolder("Personal Folders\Inbox")
 Set folder = GetFolder("Personal Folders\Drafts")
 If Not (folder Is Nothing) Then
 folder.Display
 End If
 End Sub
 

Function GetFolder(ByVal FolderPath As String) As Outlook.folder
 Dim TestFolder As Outlook.folder
 Dim FoldersArray As Variant
 Dim i As Integer
On Error GoTo GetFolder_Error
 If Left(FolderPath, 2) = "\\" Then
 FolderPath = Right(FolderPath, Len(FolderPath) - 2)
 End If
 'Convert folderpath to array
 FoldersArray = Split(FolderPath, "\")
 Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
 If Not TestFolder Is Nothing Then
 For i = 1 To UBound(FoldersArray, 1)
 Dim SubFolders As Outlook.Folders
 Set SubFolders = TestFolder.Folders
 Set TestFolder = SubFolders.Item(FoldersArray(i))
 If TestFolder Is Nothing Then
 Set GetFolder = Nothing
 End If
 Next
 End If
 'Return the TestFolder
 Set GetFolder = TestFolder
 Exit Function
GetFolder_Error:
 Set GetFolder = Nothing
 Exit Function
 End Function

I then found this code on the internet but cannot make it work although this is the line of code that I have created having modified the original line
Set moveToFolder = ns.Folders("Personal Folders\Inbox").Folders("Personal Folders\Drafts").Folders

but I get an error message saying target folder not found.

Code:

'Outlook VB Macro to move selected mail item(s) to a target folder
Sub MoveToFiled()
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")

Set moveToFolder = ns.Folders("Personal Folders\Inbox").Folders("Personal Folders\Drafts").Folders

If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item selected")
   Exit Sub
End If
If moveToFolder Is Nothing Then
   MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
For Each objItem In Application.ActiveExplorer.Selection
   If moveToFolder.DefaultItemType = olMailItem Then
      If objItem.Class = olMail Then
         objItem.Move moveToFolder
      End If
  End If
Next
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
End Sub

would appreciate the help
thank you smiler44