Hi,
First of all, I am new to VBA so hopefully this will be an easy fix.
I have created a VBA script to move a selected email to a public folder location. The script prompts using an inputbox (in this example it's a project folder "001") and moves the email to the public folder called >Projects>"001 - TEST FOLDER". It uses the inputbox data as the folder location.
It is currently working until the folders reach above 099. All Public Folders are labelled like "001 - Test Folder", "023 - Project Name", "042 - Random" etc.
Is it just a case that I'm using the wrong variable type for the inputbox data?
Any help is appreciated.
First of all, I am new to VBA so hopefully this will be an easy fix.
I have created a VBA script to move a selected email to a public folder location. The script prompts using an inputbox (in this example it's a project folder "001") and moves the email to the public folder called >Projects>"001 - TEST FOLDER". It uses the inputbox data as the folder location.
It is currently working until the folders reach above 099. All Public Folders are labelled like "001 - Test Folder", "023 - Project Name", "042 - Random" etc.
Is it just a case that I'm using the wrong variable type for the inputbox data?
Any help is appreciated.
Code:
Sub MoveProject()
'Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Dim strProject As String
Dim Proceed As VbMsgBoxResult
Set objNS = Application.GetNamespace("MAPI")
Dim appOutlook As New Outlook.Application
Set nms = appOutlook.GetNamespace("MAPI")
strProject = InputBox("Please enter Project")
' 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 objFolder = objNS.Folders("Public Folders").Folders("All Public Folders").Folders("Projects").Folders(strProject)
strFolder = nms.Session.GetDefaultFolder(olPublicFoldersAllPublicFolders).Parent
Set fld = nms.Folders(strFolder).Folders("All Public Folders").Folders("Projects").Folders(strProject)
For intX = 1 To objNS.Folders.Count
If objNS.Folders.Item(intX).Name = "Public Folders" Then
Exit For
End If
Next
If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is Selected
Exit Sub
End If
Set oSelection = Application.ActiveExplorer.Selection
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 " & strProject & "?", _
vbYesNo + vbQuestion, "Confirm Move")
If Proceed = vbYes Then
Set objEmail = objX
objEmail.Move fld
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub