Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

error during export Outlook folder structure: too long folder names

Posted on 2012-04-09
26
Medium Priority
?
808 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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
 
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 2000 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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will help to fix the below errors for MS Exchange Server 2013 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
The core idea of this article is to make you acquainted with the best way in which you can export Exchange mailbox to PST format.
Introduction to Processes
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.

688 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