You may find Option Explicit useful.
http://office.blogs.webucator.com/20...plicit-in-vba/
See if this does what you want.
Code:
Option Explicit
Sub MoveProject()
Dim objNS As Outlook.Namespace
Dim projectParentFolder As Outlook.MAPIFolder
Dim objFolder As Outlook.MAPIFolder
Dim objX As Object
Dim strProject As String
Dim Proceed As VbMsgBoxResult
Dim strFolder As String
Dim intX As Long
If Application.ActiveExplorer.Selection.count = 0 Then
'Require that this procedure be called only when a message is Selected
MsgBox "Select at least one mailitem", , "MoveProject"
Exit Sub
End If
strProject = InputBox("Please enter Project")
strProject = Trim(strProject)
If Len(strProject) > 4 Then strProject = Left(strProject, 4)
Set objNS = Application.GetNamespace("MAPI")
' If the public folder location is not \\public folders\all public folders\projects\001 etc
' then the below line is required to be changed
Set projectParentFolder = objNS.Session.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Projects")
For intX = 1 To projectParentFolder.Folders.count
If Left(projectParentFolder.Folders.item(intX).name, Len(strProject)) = strProject Then
Set objFolder = projectParentFolder.Folders.item(intX)
Exit For
End If
Next
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly
GoTo exitRoutine
End If
For intX = ActiveExplorer.Selection.count To 1 Step -1
Set objX = ActiveExplorer.Selection.item(intX)
If objX.Class = olMail Then
Proceed = MsgBox("Are you sure you want move the message to the Projects Folder " & objFolder & "?", _
vbYesNo + vbQuestion, "Confirm Move")
If Proceed = vbYes Then
objX.Move objFolder
End If
End If
Next
exitRoutine:
Set objX = Nothing
Set objFolder = Nothing
Set projectParentFolder = Nothing
Set objNS = Nothing
End Sub