#1
|
|||
|
|||
Outlook VBA to move selected email to a public folder
Hi,
Quick note, I am not too familiar with VBA as I have only created basic scripts for personal use etc. I am currently creating a script to move a currently selected email to a public folder location based on the input of a user. The main Public Folder path remains static ie 'All Public Folders\Projects\'. The 'Projects' folder however has subfolders all beginning with a number followed by a job name ie '001 - Test Name' The script prompts for user input, at this point the project number is supplied and is 3-4 numeric digits eg '001'. So far I have it working with folders below 099. Anything above 099, I get a 'Run-time error '440': Array index out of bounds.' If I type the complete folder name when prompted - eg '254 - Test Name', the email is moved successfully. Is it as simple as using the wrong variable type? I was also thinking I may need to search the Public Folder using the input value to find the matching folder and set it as the destination. I am unable to get that part working correctly. Any help is greatly appreciated. Here's my example code 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") strFolder = nms.Session.GetDefaultFolder(olPublicFoldersAllPublicFolders).Parent ' 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 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 objFolder Is Nothing Then 'MsgBox "This folder doesn't exist!", vbOKOnly 'End If 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 |
#2
|
|||
|
|||
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 |
#3
|
|||
|
|||
Thanks for the reply.
I managed to get it working by searching the Public Folders sub folders for a match to the input variable string. I added the following. Code:
ReDim sArray(0) As String If fld.Folders.Count Then For i = 1 To fld.Folders.Count If Left(fld.Folders(i).Name, 3) = strProject Then iElement = IIf(sArray(0) = "", 0, UBound(sArray) + 1) ReDim Preserve sArray(iElement) As String sArray(iElement) = fld.Folders(i).Name End If Next i |
Tags |
public folder, script, vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Forwarding email from a public folder to my Inbox | ray500 | Outlook | 2 | 08-23-2016 07:20 AM |
how to move the email directly to secondary mailbox sent item folder | gregory | Outlook | 2 | 04-28-2012 01:21 AM |
Outlook for Mac 2011 - public folder drag/drop | LakeShoreDriving | Outlook | 0 | 04-09-2012 11:27 PM |
User cannot move email messages within Outlook Inbox folder and sub-folders. | Darsss | Outlook | 5 | 06-06-2011 11:37 PM |
Forwarding email from a Public Folder | ray500 | Outlook | 1 | 08-20-2010 03:06 PM |