Looking for help with a Macro

[Labrat407]

Hello,

I am looking for a Macro to assist in archiving our folders from a group mailbox. I have found this ( http :// vbaexpress.com/kb/getarticle.php?kb_id=875#instr ) (I can not yet post links) macro, it is a start, but I get an error when it tries to create the folder, due in part to the depth of the folder string. Also I am looking to save the email in a slightly different format.

Intended macro functionality:

1. As per the earlier link, allow the user to select the folder to archive
2. As per the earlier link, allow the user to select the folder to archive to
3. The folder location should default to one specific location and allow the selection under that folder to save to
4. Only the Outlook Folder name is to beused, not the Outlook Folder path and current folder
5. This is the tricky one, the emails should be saves as embeded objects in a word document with the same name as the folder.
6. Outlook Version 14 and Office 2010
7. If the folder exists, allow the ability to append the current word document (nice to have)

My current error is Run-time error '76': Path not found when it gets to this line FSO.CreateFolder (StrFolderPath)

The string is similar to this (stripped out identy keywords) "G:\folder1\Folder2\Team\My_folder\email_test\Inbox\4000 outlook1\4100 Outlook Agents\4120 Minemy\1-FUP\"

I would like to have "G:\folder1\Folder2\Team\My_folder\email_test\FolderPathHere\"

I am passingly comfortable with code with Googles kind help, but getting folder structures and Objects in other applications is not yet a strength. I am working on this on my own but would appreciate any help.


Thanks

[westconn1]

what is the value of strfolderpath when the error occurs?

[Labrat407]

what is the value of strfolderpath when the error occurs?

The path is the full defined path of all the folders to the current active folder. I would need to have just the single currently active folder to create the folder on the network drive to keep the folder path shorter.

[westconn1]

you can try like this to see if it does as required

Dim m As MailItem
Set basefolder = fso.GetFolder("G:\folder1\Folder2\Team\My_folder\email_test")  ' must exist
Set m = ActiveExplorer.Selection(1)
Set e = m.Parent
mypath = ""
Do Until e = "Inbox"
    mypath = e.Name & "\" & mypath
    Set e = e.Parent
Loop
folds = Split(mypath, "\")
For i = 0 To UBound(folds) - 1
    Set basefolder = fso.CreateFolder(basefolder.Path & "\" & folds(i))
    
Next

assumes a mailitem is selected in some folder below inbox

[Labrat407]

you can try like this to see if it does as required

Dim m As MailItem
Set basefolder = fso.GetFolder("G:\folder1\Folder2\Team\My_folder\email_test")  ' must exist
Set m = ActiveExplorer.Selection(1)
Set e = m.Parent
mypath = ""
Do Until e = "Inbox"
    mypath = e.Name & "\" & mypath
    Set e = e.Parent
Loop
folds = Split(mypath, "\")
For i = 0 To UBound(folds) - 1
    Set basefolder = fso.CreateFolder(basefolder.Path & "\" & folds(i))
    
Next

assumes a mailitem is selected in some folder below inbox

Thanks, I can follow this code as to the function, but not seeing where or how to implement it in the macro. I liked the idea of the prompts to pick location and email folder, but can work with the defined folder for the save location.

[westconn1]

i probably did not read the original post well enough

you can try incorporating this part into your original code, in place of the line that gives error

folds = Split(StrFolderPath, "\")
Set basefolder = fso.GetFolder(folds(0) & "\")  
On Error Resume Next   ' start inline error handling
For i = 1 To UBound(folds)
    Set basefolder = fso.GetFolder(basefolder.Path & "\" & folds(i))
    If Err = 76 Then Set basefolder = fso.CreateFolder(basefolder.Path & "\" & folds(i)): Err.Clear
Next
On Error GoTo 0  '  turn off inline error handling