Outlook Marco for "Search folder and move the item" no longer works

ashringg

New Member
Joined
Nov 2, 2023
Messages
13
Office Version
  1. 2016
Platform
  1. Windows
I found this code from user Nymphe1410, on another form, and it has been helping my workflow for over 2 weeks but it no longer working. My trust center has macros enabled, I restarted the program, deleted the macro, and even changed the project name. A window would pop up to find the folder and would then provide a follow-up window to go to the folder or move email then go to the folder. Do you have any suggestions on how i can fix this?

Note: The purpose of this is code is to find folder and either go to the folder or move the email(or emails) and go to the folder. Example: Run the macro; Find folder with the name *jobsite*. Get path of this folder. Move the active item (email) to this folder (Job123-jobsite-xyz).


VBA Code:
Option Explicit

Private m_Folder As Outlook.MAPIFolder

Private m_Find As String

Private m_Wildcard As Boolean





Private Const SpeedUp As Boolean = False

Private Const StopAtFirstMatch As Boolean = True





Public Sub FindFolder()

Dim Name$

Dim Folders As Outlook.Folders



'additons for move to folder

Dim objNS As Outlook.NameSpace

Dim objItem As Outlook.MailItem

Set objNS = Application.GetNamespace("MAPI")

Set objItem = Application.ActiveExplorer.Selection.Item(1)

'additions for move to folder





Set m_Folder = Nothing

m_Find = ""

m_Wildcard = False





Name = InputBox("Find folder by name:", "Search folder & Move Item")

If Len(Trim$(Name)) = 0 Then Exit Sub

m_Find = "*" & Name & "*" '<--- good addition so that we don't need to add * everytime.





m_Find = LCase$(m_Find)

m_Find = Replace(m_Find, "%", "*")

m_Wildcard = (InStr(m_Find, "*"))





Set Folders = Application.Session.Folders

LoopFolders Folders





If Not m_Folder Is Nothing Then



If MsgBox("Activate folder or just move the item to it: " & vbCrLf & vbCrLf & m_Folder.FolderPath & vbNewLine & vbNewLine & "Yes = Activate the folder only" & vbNewLine & "No = Move the item and activate", vbQuestion Or vbYesNo) = vbYes Then



'only activate the folder:



Set Application.ActiveExplorer.CurrentFolder = m_Folder



Else

' move the item to the found folder and activate to be sure:





objItem.Move m_Folder '<-- where magic happens :)





Set Application.ActiveExplorer.CurrentFolder = m_Folder '<-- this line can be deactivated if not needed.



End If

Else

MsgBox "Not found", vbInformation

End If

End Sub





Private Sub LoopFolders(Folders As Outlook.Folders)

Dim F As Outlook.MAPIFolder

Dim Found As Boolean



If SpeedUp = False Then DoEvents





For Each F In Folders

If m_Wildcard Then

Found = (LCase$(F.Name) Like m_Find)

Else

Found = (LCase$(F.Name) = m_Find)

End If





If Found Then

If StopAtFirstMatch = False Then

If MsgBox("Found: " & vbCrLf & F.FolderPath & vbCrLf & vbCrLf & "Continue?", vbQuestion Or vbYesNo) = vbYes Then

Found = False

End If

End If

End If

If Found Then

Set m_Folder = F

Exit For

Else

LoopFolders F.Folders

If Not m_Folder Is Nothing Then Exit For

End If

Next

End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,224,820
Messages
6,181,157
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top