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