vba to create a shared mailbox folder

[Mark White]

Hi
I'm using Outlook 2013 and need to move emails into an archive subdirectory which is fine as per code listed here, but if that subdirectory doesn't exist then my code falls over.
My account has all permissions necessary but in this snippet from code found on this site:
FoldersArray = Split(pstrFolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For intI = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(intI))
If oFolder Is Nothing Then
Application.Session.Folders.Add strNew, olFolder
End If
Next
End If
The line SubFolders.Item(FoldersArray(intI)) falls over if the folder doesn't exist and I can't see how to add something like Application.Session.Folders.Add "NewFolderName"

Any ideas gratefully accepted
Cheers
Mark

 

[Diane Poremsky]

It could be related to the array - where are you getting the folder name from? It looks like the split function is splitting an existing folder path, not creating a new folder. (It looks like that code is from the getfolderpath function, which is used to get the folder path of secondary data files).

The arrary finds the folder in the path but if the folder you want to use doesn't exist, you need to pass a string variable to the code to create the folder.


This is how i create folders from a list of names (in an excel sheet) - newfoldername is a string variable that is the new folder name. (in the example at Macro to file Outlook email by sender's display name, i use the sender's name. )

On Error Resume Next
Dim objNewFolder As Outlook.Folder
Set objNewFolder = objParentFolder.Folders(newFolderName)

If objNewFolder Is Nothing Then
Set objNewFolder = objParentFolder.Folders.Add(newFolderName)
End If

 

[Mark White]

Thanks for that, Diane,
however the sub directory to save the email to is contained within the email... I pick that up earlier and then use the GetFolderPath () function found here http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/ to then Move the email to the folder...

I've ascertained that it raises error -2147221233 and so wrote some code like this in the error handler:
If Err.Number = -2147221233 Then
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
For intI = 1 To UBound(FoldersArray, 1) - 1 '*** go back to the Directory above the error
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(intI))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
oFolder.Folders.Add strNew '*** this is found earlier by using InStrRev etc
End If
but it all seems a bit cluncky and not terribly generic ...

 

[Diane Poremsky]

I'm not sure why it's triggering an error (posting your full code might help) - are you doing it this way:

use getfolderpath to set the parent folder first -
objParentFolder = getfolderpath ("parent folder\path")

You could work the getfolderpath function into the code so you only need one macro - but regardless of how you do it, get the parent folder first.

if you get the parent path from the message too, pass it to getfolderpath using a string variable:
objParentFolder = getfolderpath (strPathfromMessage)

since you are getting it from the mail, i would use
newFoldername = however you got it from the message

On Error Resume Next
Dim objNewFolder As Outlook.Folder
Set objNewFolder = objParentFolder.Folders(newFolderName)

If objNewFolder Is Nothing Then
Set objNewFolder = objParentFolder.Folders.Add(newFolderName)
End If