Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Office > Outlook

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 10-14-2013, 09:48 PM
aaroncrt aaroncrt is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Oct 2013
Posts: 2
aaroncrt is on a distinguished road
Default 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
Reply With Quote
  #2  
Old 10-21-2013, 05:05 PM
niton niton is offline Windows 7 64bit Office 2010 64bit
Competent Performer
 
Join Date: Jul 2012
Posts: 102
niton is on a distinguished road
Default

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
Reply With Quote
  #3  
Old 10-21-2013, 05:11 PM
aaroncrt aaroncrt is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Oct 2013
Posts: 2
aaroncrt is on a distinguished road
Default

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
Reply With Quote
Reply

Tags
public folder, script, vba
Please reply to this thread with any new information or opinions.

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 03:03 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft