Hi,
I need to make some order thru my cases and need to move all the closed ones to a specific folder.
I managed to find a way, sort of, but this solution only moves 1 folder at a time and the thing is there are >200 cases which needs to be moved.
All the folders are in a shared e-mail account and the way I can identify the folders that needs to be moved is by theirs last 6 characters found in the end of the folder name, which is actually an unique ID. Specifically a folder is named this way: "string.ddmmyy.string.string.string.ID"
The only data I have for identifying and moving this folders is a list with IDs which came in a excel file like that:


123456
123457
123458
and so on...


I think what I am searching for is a vector, but don't have much experience with, so could you please help me figure a way to move to insert all the criteria at once to move the folders and to identify the IDs which couldn't be found/moved?


Here is what I have so far (search for the entered ID in the text box, loops thru folders, move it to a specific one and displays a message box). I run the FindFolder macro.


Many thanks!


Private myFolder As Outlook.MAPIFolder
Private MyFolderWild As Boolean
Private MyFind As String


Public Sub FindFolder()
Dim Name$
Dim Folders As Outlook.Folders
Dim myNewFolder As Outlook.folder
Dim olApp As Outlook.Application
Dim NS As NameSpace
Dim olDestFolder As Object
Dim folder_name As String


Set myFolder = Nothing
MyFind = ""
MyFolderWild = False


Name = "*" & InputBox("Enter the Folder Name that you would like to find:")
If Len(Trim$(Name)) = 0 Then Exit Sub
MyFind = Name


MyFind = LCase$(MyFind)
MyFind = Replace(MyFind, "%", "*")
MyFolderWild = (InStr(MyFind, "*"))


Set Folders = Application.Session.Folders
LoopFolders Folders


If Not myFolder Is Nothing Then
If MsgBox("Do you want to move this folder ?" & vbCrLf & myFolder.folderPath, vbQuestion Or vbYesNo, "Found your Folder:") = vbYes Then
Set Application.ActiveExplorer.CurrentFolder = myFolder
Set olApp = Application
Set NS = olApp.GetNamespace("MAPI")
Set olDestFolder = NS.Folders("email_account").Folders("Inbox").Folders("cleanup")
myFolder.MoveTo olDestFolder
Call Repeat
End If
Else
MsgBox "The folder you were looking for can not be found.", vbCritical, "Folder NOT found:"
End If
End Sub




Private Sub LoopFolders(Folders As Outlook.Folders)
Dim F As Outlook.MAPIFolder
Dim Found As Boolean


For Each F In Folders
If MyFolderWild Then
Found = (LCase$(F.Name) Like MyFind)
Else
Found = (LCase$(F.Name) = MyFind)
End If


If Found Then
Set myFolder = F
Exit For
Else
LoopFolders F.Folders
If Not myFolder Is Nothing Then Exit For
End If
Next
End Sub




Sub Repeat()
If MsgBox("The folder has been successfully moved." & vbCrLf & "Do you want to move another folder?", vbQuestion Or vbYesNo) = vbYes Then
Call FindFolder
Else
End
Exit Sub
End If
End Sub