Solved

error during export Outlook folder structure: too long folder names

Posted on 2012-04-09
26
794 Views
Last Modified: 2012-04-11
Dear experts,


I've a vbs script (see attachment) provided by amazing skilled scripter Crhis to export outlook folder structure to outside outlook, on a file server.
I have some problem due too long characters (more than 256) during this export (see error message. There are many nested folders.

My question, is it still possible to export these long folder names to a file server? when it is not possible is their a way to list these outlook folders and its nested folders with their folder structure to a txt file so that I can export them manually?

simple example: outlook long folder names
- outlook
   -PrintingDEP1
      -Printing for level1 responsible
           -SDFDSFDFFFFG DFDFDFDFDF fDFDFF
             - dsfmmmmmm mmmmm
                    -fdsfdfsddfdsf fffffffffffffffffffff


K rgs

long folder namesexport-outlook-folders.txt
0
Comment
Question by:DigitBoy
  • 13
  • 12
26 Comments
 
LVL 17

Expert Comment

by:Anuroopsundd
ID: 37822847
can you try with below way..  to export foldernames.
http://www.howto-outlook.com/howto/exportfoldernames.htm
0
 

Author Comment

by:DigitBoy
ID: 37823003
Hi,

the first part is to export the too long root folder with its nested subfolders and not everything if it is not possibe with coding. I've found same link as you are :).

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37823405
I have played around a bit trying to work around the issue ... the following which is basically the same as before with a small change, (after a ton of experimentation!) seems to work in my tests:

Option Explicit
Dim fso
Dim max,min
max=1000000
min=1
Randomize

Q_26908386

Sub Q_26908386()
Dim fldr
dim strRootDir
Dim olkApp
    
    strRootDir = "c:\deleteme"
    Set fso = CreateObject("scripting.filesystemobject")
    Set olkApp = CreateObject("outlook.application")
'    Set fldr = olkApp.Session.pickfolder
    Set fldr = olkApp.Session.getdefaultfolder(6)
    Q_26908386_recur fldr, strRootDir & "\" & FileNameCharsOnly(fldr.name)
'    For Each fldr In Application.Session.folders
'        Q_26908386_recur fldr, strRootDir
'    Next
    Set fso = Nothing

End Sub

Sub Q_26908386_recur(fldr, DOSFolderPath)
Dim subFldr
Dim saveFolder
Dim mai

    'Do the root export
    If fldr.DefaultItemType = 0 Then
        navtoDosFolder DOSFolderPath, True
        For Each mai In fldr.items
            If mai.Class = 43 Then
                If mai.Subject = "" Then
                Else
					If mai.entryid <> "" Then
						Set saveFolder = getdir(DOSFolderPath)
	                    mai.saveas getSaveName(saveFolder.shortpath & "\Mail " & mai.entryid & ".msg"), 3
	                Else
						Set saveFolder = getdir(DOSFolderPath)
	                    mai.saveas getSaveName(savefolder.ShortPath & "\" & "mail " & Date() & Int((max-min+1)*Rnd+min) & ".msg"), 3
	                End if
                End If
            End If
        Next
    End If
    'Do the recursion
    For Each subFldr In fldr.folders
        Q_26908386_recur subFldr, DOSFolderPath & "\" & FileNameCharsOnly(subFldr.name)
    Next

End Sub

Function FileNameCharsOnly(str)
Dim regEx
Dim matches
Dim arr()
Dim cnt
Dim dirColon
    
    dirColon = Mid(str, 2, 1) = ":"
    Set regEx = CreateObject("vbscript.regexp")
    With regEx
        .Global = True
        .IgnoreCase = True
        .Pattern = "[^A-Za-z0-9$ %'\-_@~`\(\)\+\\,;=\[\]§-ÿ]"
    End With
    FileNameCharsOnly = regEx.Replace(str, " ")
    regEx.Pattern = " {2,}"
    FileNameCharsOnly = regEx.Replace(FileNameCharsOnly, " ")
    'If dirColon Then FileNameCharsOnly = Replace(FileNameCharsOnly, " ", ":", 1, 1)

End Function

Function navtoDosFolder(dosPath, createFolders)
Dim fldrs
Dim rootdir
Dim fldrIndex
    
    navtoDosFolder = True
    If Right(dosPath, 1) = "\" Then dosPath = Left(dosPath, Len(dosPath) - 1)
    If Len(dosPath) = 0 Then
        navtoDosFolder = False
        Exit Function
    End If
    fldrs = Split(dosPath, "\")
    rootdir = fldrs(0)
    If Not fso.folderexists(rootdir) Then
        navtoDosFolder = False
        Exit Function
    End If
    For fldrIndex = 1 To UBound(fldrs)
        rootdir = rootdir & "\" & fldrs(fldrIndex)
        If Not fso.folderexists(rootdir) Then
            If createFolders Then
                fso.createfolder("\\?\" & rootdir)
            Else
                navtoDosFolder = False
            End If
        End If
    Next
End Function

Function getSaveName(strDosNameandPath)
Dim fn
Dim ft
Dim intIncrement

    fn = Left(strDosNameandPath, InStrRev(strDosNameandPath, ".") - 1)
    ft = Right(strDosNameandPath, Len(strDosNameandPath) - InStrRev(strDosNameandPath, ".") + 1)
        Do While fso.FileExists(fn & "_" & intIncrement & ft)
            intIncrement = intIncrement + 1
        Loop
        getSaveName = fn & "_" & intIncrement & ft

End Function

Function getDir(str)
Dim obj
Dim fso
Dim arr
Dim elem
Dim fldr

    Set fso = CreateObject("Scripting.FileSystemObject")
    arr = Split(str, "\")
    For Each elem In arr
        If isempty(fldr) Then
            Set fldr = fso.getfolder(elem & "\")
        Else
            Set fldr = fso.getfolder(fldr.shortpath & "\" & elem)
        End If
    Next
    Set getDir = fldr

End Function

Open in new window


Note it WILL suffer for long file names if that happens, (i.e. it addresses long file names albeit by using the short file names ... i.e. too great a nesting will still have issues BUT that will take a lot more to exceed than simply lots of chars in folder names) ... but the use of the entryid as already used should preclude the long file name issue.

Chris
0
 

Author Comment

by:DigitBoy
ID: 37823435
The code from "http://www.howto-outlook.com/howto/exportfoldernames.htm" export only folders and the code in attached file exports folders structure with the mail items.

Is there way to combine these 2 codes into one please? Because the code from outlook.com is exporting fine the very long folder names and nested folders.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37823588
On examination it looks as though that post is not in response to my post ... or so I am assuming for the moment and awaiting your trial of the code to see if it works in your installation.

Chris
0
 

Author Comment

by:DigitBoy
ID: 37823608
Hi Chris,

I didn't see your comment with your code (my mistake :( ) and because of that I post to soon my comment. My appologize. I will test your code.
Thanks again for your help.

K rgs
0
 

Author Comment

by:DigitBoy
ID: 37824472
Hi Chris,

with the code I cannot select anymore a folder in outlook. It exports only inboxes, some short named folders and some mails with short subject names.

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37824496
OOPS

A quick hack I made to simplify testing see lines 18 & 19 and replace:


'    Set fldr = olkApp.Session.pickfolder
    Set fldr = olkApp.Session.getdefaultfolder(6)

with

    Set fldr = olkApp.Session.pickfolder
'    Set fldr = olkApp.Session.getdefaultfolder(6)

Other than that it shouldn't be picking out some folders/items so if you can give any pointers as to what is happening?

Chris
0
 

Author Comment

by:DigitBoy
ID: 37824684
Hi Chris,

thanks for the fast support.
During the test I got some error messages :(, beside of that not all folders are exported:

Error1
error-1-FolderAlreadyExists
My test folder structure in outlook:
TEst-outlook-folder-Structure
After the export in DOS
Folder-dos-Structure

All the mails are exported with very strange name:
Mail-differentname


K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37824857
1. To remove the 'silly' names we could retry using the subject
2. Will need to allow for duplicate subjects though, a job for tomorrow perhaps
3. The root folder 'deleteme' I shou;d have mentioned:

edit line 15

    strRootDir = "c:\deleteme"
to point to your desired root folder in dos

Other than that are we getting all the folders or is just the last one that is being missed ... need to repeat my test to see if that is happening to me if so - so that I can test any new solution?

Chris
0
 

Author Comment

by:DigitBoy
ID: 37824897
Hi chris,

as you can see I'm real a zero in coding :). I will point to the right one.

The last folder is missing. We have many folders like these and also with much more sub folders.

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37825059
I've just tested and it works fine for me, corrected bug affecting incremental file name

Option Explicit
Dim fso
Dim max,min
max=1000000
min=1
Randomize

Q_26908386

Sub Q_26908386()
Dim fldr
dim strRootDir
Dim olkApp
    
    strRootDir = "c:\deleteme"
    Set fso = CreateObject("scripting.filesystemobject")
    Set olkApp = CreateObject("outlook.application")
    Set fldr = olkApp.Session.pickfolder
'    Set fldr = olkApp.Session.getdefaultfolder(6)
    Q_26908386_recur fldr, strRootDir & "\" & FileNameCharsOnly(fldr.name)
    Set fso = Nothing

End Sub

Sub Q_26908386_recur(fldr, DOSFolderPath)
Dim subFldr
Dim saveFolder
Dim mai
Dim strFileName

    'Do the root export
    If fldr.DefaultItemType = 0 Then
        navtoDosFolder DOSFolderPath, True
        For Each mai In fldr.items
            If mai.Class = 43 Then
                If mai.Subject = "" Then
                Else
           	    Set saveFolder = getdir(DOSFolderPath)
	            strFileName = getSaveName(saveFolder.shortpath & "\" & FileNameCharsOnly(mai.subject) & ".msg")
	            mai.saveas strFileName, 3
                End If
            End If
        Next
    End If
    'Do the recursion
    For Each subFldr In fldr.folders
        Q_26908386_recur subFldr, DOSFolderPath & "\" & FileNameCharsOnly(subFldr.name)
    Next

End Sub

Function FileNameCharsOnly(str)
Dim regEx
Dim matches
Dim arr()
Dim cnt
Dim dirColon
    
    dirColon = Mid(str, 2, 1) = ":"
    Set regEx = CreateObject("vbscript.regexp")
    With regEx
        .Global = True
        .IgnoreCase = True
        .Pattern = "[^A-Za-z0-9$ %'\-_@~`\(\)\+\\,;=\[\]§-ÿ]"
    End With
    FileNameCharsOnly = regEx.Replace(str, " ")
    regEx.Pattern = " {2,}"
    FileNameCharsOnly = regEx.Replace(FileNameCharsOnly, " ")
    'If dirColon Then FileNameCharsOnly = Replace(FileNameCharsOnly, " ", ":", 1, 1)

End Function

Function navtoDosFolder(dosPath, createFolders)
Dim fldrs
Dim rootdir
Dim fldrIndex
    
    navtoDosFolder = True
    If Right(dosPath, 1) = "\" Then dosPath = Left(dosPath, Len(dosPath) - 1)
    If Len(dosPath) = 0 Then
        navtoDosFolder = False
        Exit Function
    End If
    fldrs = Split(dosPath, "\")
    rootdir = fldrs(0)
    If Not fso.folderexists(rootdir) Then
        navtoDosFolder = False
        Exit Function
    End If
    For fldrIndex = 1 To UBound(fldrs)
        rootdir = rootdir & "\" & fldrs(fldrIndex)
        If Not fso.folderexists(rootdir) Then
            If createFolders Then
WScript.Echo rootdir
                fso.createfolder(rootdir)
            Else
                navtoDosFolder = False
            End If
        End If
    Next
End Function

Function getSaveName(strDosNameandPath)
Dim fn
Dim ft
Dim intIncrement

    fn = Left(strDosNameandPath, InStrRev(strDosNameandPath, ".") - 1)
    ft = Right(strDosNameandPath, Len(strDosNameandPath) - InStrRev(strDosNameandPath, ".") + 1)
        Do While fso.FileExists(fn & "_" & intIncrement & ft)
            intIncrement = intIncrement + 1
        Loop
        getSaveName = fn & "_" & intIncrement & ft

End Function

Function getDir(str)
Dim obj
Dim fso
Dim arr
Dim elem
Dim fldr

'    str = "c:\deleteme\Inbox\abcdefghijklmnopqrstuvwxyz\abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz\abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz\abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
    Set fso = CreateObject("Scripting.FileSystemObject")
    arr = Split(str, "\")
    For Each elem In arr
        If isempty(fldr) Then
            Set fldr = fso.getfolder(elem & "\")
        Else
            Set fldr = fso.getfolder(fldr.shortpath & "\" & elem)
        End If
    Next
    Set getDir = fldr

End Function

Open in new window

0
 

Author Comment

by:DigitBoy
ID: 37826855
Hi Chris,


the mail items are exported as msg, but the 3 last folders with the content are not exported.

error:
Line 95
Char 17
Error File not found
Code 800A0035

Notexported
K rgs
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37826907
Interestingly it looks as though that is at about the 255 character mark so can you try in for example file explorer manually creating the next level of folder ... does it work?

Chris
0
 

Author Comment

by:DigitBoy
ID: 37826930
Hi Chris,

yes it works. I created another 3 subfolders without errors in windows explorer.

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37827035
Okay, the 'fix' does address long folder names, (in my tests) but obviously there is another issue affecting overall path lengths.  Haven't a clue about such a solution as yet but i'll ponder.

Chris
0
 

Author Comment

by:DigitBoy
ID: 37827223
Hi Chris,

Sorry to bother you more, but I've noticed (I couldn't test it before) that "Public folders", where i have permissions, cannot be exported. There is no error message.

Public Folder:
Public Folders
K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37827268
Unfortunately I don't have access to any public folders so cannot test.  I take it you can navigate to the folder but that nothing at all happens?  i.e. if one or more folders are generated then that might give a clue.

It will be interesting to see if you can drag a copy from the public folder to the desktop ... this will confirm the permissions to copy as such for the script ... ensure it' a copy and then delete it gain from the desktop.

Chris
0
 

Author Comment

by:DigitBoy
ID: 37827330
Hi Chris,

yes indeed I can navigate to folders, but nothing happens. There is no trace of exported files.
As you asked I tried and it worked to copy and paste to my local drive.

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37827597
As mentioned I have no public folders to work with ... but I see no resin for any issues in the code so it has to be something to do with permissions but I know not what and have no means to investigate so on that one I have to say it's beyond me.

Still have to do a test on overall path length

Chris
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 37828259
Various bugs with the path, testing as below ok so hopefully ok for you

Option Explicit
Dim fso
Dim max,min
max=1000000
min=1
Randomize

Q_26908386

Sub Q_26908386()
Dim fldr
dim strRootDir
Dim olkApp
    
    strRootDir = "c:\deleteme"
    Set fso = CreateObject("scripting.filesystemobject")
    Set olkApp = CreateObject("outlook.application")
'    Set fldr = olkApp.Session.pickfolder
    Set fldr = olkApp.Session.getdefaultfolder(6)
    Q_26908386_recur fldr, strRootDir & "\" & FileNameCharsOnly(fldr.name)
'    For Each fldr In Application.Session.folders
'        Q_26908386_recur fldr, strRootDir
'    Next
    Set fso = Nothing

End Sub

Sub Q_26908386_recur(fldr, DOSFolderPath)
Dim subFldr
Dim saveFolder
Dim mai
Dim strFileName
Dim shortDOSFolderPath

    'Do the root export
    If fldr.DefaultItemType = 0 Then
        shortDOSFolderPath = navtoDosFolder(DOSFolderPath, True)
        For Each mai In fldr.items
            If mai.Class = 43 Then
                If mai.Subject = "" Then
                Else
'					If mai.entryid <> "" Then
WScript.Echo shortDOSFolderPath
						Set saveFolder = getdir(shortDOSFolderPath)
	                    strFileName = getSaveName(saveFolder.shortpath & "\" & FileNameCharsOnly(mai.subject) & ".msg")
	                    mai.saveas strFileName, 3
'	                Else
'						Set saveFolder = getdir(DOSFolderPath)
'	                    mai.saveas getSaveName(savefolder.ShortPath & "\" & "mail " & Date() & Int((max-min+1)*Rnd+min) & ".msg"), 3
'	                End if
                End If
            End If
        Next
    End If
    'Do the recursion
    For Each subFldr In fldr.folders
        Q_26908386_recur subFldr, DOSFolderPath & "\" & FileNameCharsOnly(subFldr.name)
    Next

End Sub

Function FileNameCharsOnly(str)
Dim regEx
Dim matches
Dim arr()
Dim cnt
Dim dirColon
    
    dirColon = Mid(str, 2, 1) = ":"
    Set regEx = CreateObject("vbscript.regexp")
    With regEx
        .Global = True
        .IgnoreCase = True
        .Pattern = "[^A-Za-z0-9$ %'\-_@~`\(\)\+\\,;=\[\]§-ÿ]"
    End With
    FileNameCharsOnly = regEx.Replace(str, " ")
    regEx.Pattern = " {2,}"
    FileNameCharsOnly = regEx.Replace(FileNameCharsOnly, " ")
    'If dirColon Then FileNameCharsOnly = Replace(FileNameCharsOnly, " ", ":", 1, 1)

End Function

Function navtoDosFolder(dosPath, createFolders)
Dim fldrs
Dim shortFolders
Dim rootdir
Dim fldrIndex
    
    navtoDosFolder = ""
    If Right(dosPath, 1) = "\" Then dosPath = Left(dosPath, Len(dosPath) - 1)
    If Len(dosPath) = 0 Then
        navtoDosFolder = ""
        Exit Function
    End If
    fldrs = Split(dosPath, "\")
    shortFolders = Split(dosPath, "\")
    rootdir = shortFolders(0)
    If Not fso.folderexists(rootdir) Then
        navtoDosFolder = ""
        Exit Function
    End If
    For fldrIndex = 1 To UBound(shortFolders)
'        rootdir = rootdir & "\" & fldrs(fldrIndex)
        If Not fso.folderexists(rootdir & "\" & shortFolders(fldrIndex)) Then
            If createFolders Then
				getDir(rootdir).subfolders.add(shortFolders(fldrIndex))
            Else
                navtoDosFolder = False
            End If
        End If
        shortFolders(fldrIndex) = fso.GetFolder(rootdir & "\" & shortFolders(fldrIndex)).ShortName
        rootdir = rootdir & "\" & shortFolders(fldrIndex)
    Next
	navtoDosFolder = Join(shortFolders, "\")
End Function

Function getSaveName(strDosNameandPath)
Dim fn
Dim ft
Dim intIncrement

    fn = Left(strDosNameandPath, InStrRev(strDosNameandPath, ".") - 1)
    ft = Right(strDosNameandPath, Len(strDosNameandPath) - InStrRev(strDosNameandPath, ".") + 1)
        Do While fso.FileExists(fn & "_" & intIncrement & ft)
            intIncrement = intIncrement + 1
        Loop
        getSaveName = fn & "_" & intIncrement & ft

End Function

Function getDir(str)
Dim obj
Dim fso
Dim arr
Dim elem
Dim fldr

'    str = "c:\deleteme\Inbox\abcdefghijklmnopqrstuvwxyz\abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz\abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz\abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
    Set fso = CreateObject("Scripting.FileSystemObject")
    arr = Split(str, "\")
    For Each elem In arr
        If isempty(fldr) Then
            Set fldr = fso.getfolder(elem & "\")
        Else
            Set fldr = fso.getfolder(fldr.shortpath & "\" & elem)
        End If
    Next
    Set getDir = fldr

End Function

Open in new window


Note does not and I cannot address the public folder due to lack of knowledge and no facility for testing.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37828270
Whooops ... don't forget to toggle lines 18/19 to re-enable the pick folder

Chris
0
 

Author Comment

by:DigitBoy
ID: 37829157
Hi Chris,

thanks a lot again for tremendous work that you did. I will test it right now and will come back with feed back.

About PF, It's our fault to ask you so much.

K rgs
0
 

Author Comment

by:DigitBoy
ID: 37829260
Hi Chris,

it works like a charm. I cannot describe my happiness. Million times thank you very much :D.

I have  only one question, this line "[^A-Za-z0-9$ %'\-_@~`\(\)\+\\,;=\[\]§-ÿ]" what does it mean please?

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37830185
>>> this line "[^A-Za-z0-9$ %'\-_@~`\(\)\+\\,;=\[\]§-ÿ]" what does it mean please?

It is used as a regular expression where a regex is a common method of text processing with patterns.  In this case the pattern is a list of characters that cannot be used in a DOS path and the implementation takes each such character and replaces them with a space then just in case there are several such together it changes all multiple instances of space to a single space.

Chris
0
 

Author Closing Comment

by:DigitBoy
ID: 37832765
Again excellent support and amazing coding skills :).
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Check out this infographic on what you need to make a good email signature that will work perfectly for your organization.
If you don't know how to downgrade, my instructions below should be helpful.
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now