Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

export outlook folder structure and all the items within to network drive

Posted on 2012-04-06
19
Medium Priority
?
1,317 Views
Last Modified: 2012-04-09
Dear experts,


what we want to accomplish is to try export selected outlook folders with all their contents to a network drive (aka file server) using a VBScript (choice from the management).

It can be any folders & nested subfolders within outlook even public folders.
Content can be contacts, mails or office files (xls, doc, ppt,...).
The mail items must be exported as msg files and has to keep the hierarchal folder structure during the export.

We are looking for several weeks on googling without any luck :(.

Can one of you experts help us out please? This would be really wonderful.

Kind regards,
0
Comment
Question by:DigitBoy
  • 11
  • 8
19 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37818892
That's potentially possible using VBA but first off why / what level.

For example you could archive everything off but I am imagining that for the purpose of this question you want everything exporting to the DOS folder system.

e.g. for each folder then for each item then for each attachment?

If so how would the structure be maintained since the attachments would not be immediately attributable to a particular email.  Also some of the outlook folders may carry unacceptable characters for a dos folder so what happens in this case?

If the attachments were kept with the email as outlook mail items then this would be easier but the mail items will still be outlook mail items as saved.

ANy thoughts?

Chris
0
 

Author Comment

by:DigitBoy
ID: 37819422
Hi,

thank you for you response.

yes we want to export to ntfs folder system (eg storage) and we are aware of some disadvantages.

When you save it as msg file the attachment within mail will stay intact. There is no need to extract attachments from mails. We want to save all the mail items as msg files on a network storage and as wel fo all other non mail items have to also be saved on a storage.

If some characters are not supported by ntfs is it then possible to replace some characters by supporterd ones?

The reason why we want such kind of solution is that we are going to migrate to google. And we don't want to archive everything in pst files, but either on file storages. The data that we have is around 86GB and we don't want to everything upload to the cloud.

K regs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37819475
It is perfectly feasible to do this via VBA though the export will take a while, a long while, a long long long ...... long while but it is doable and I believe I did something of the sort previously so I will look that up rather than start from scratch

Chris
0
Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37819486
Check the solution here and let me know how you might need it adapting:

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_26908386.html

Chris
0
 

Author Comment

by:DigitBoy
ID: 37819574
thanks a lot Chris. I will try out and will come asap back to you.
0
 

Author Comment

by:DigitBoy
ID: 37819639
Hi Chris,

I've found this script on MS gallery http://gallery.technet.microsoft.com/scriptcenter/739e3d04-9f30-4517-a876-15678555a846.

Sorry for asking, but is it possible to adapt this script just to do followng please (I'm totally a zero in programming)?

- select folder within outlook wich we want to export
- keep outlook folder structure when exporting to a file storage
    --> eg:
              -Inbox
                 -testfolder (=folder)
                     -Msg file
                     ...
    --> eg:
              -Public folders
                  -Accountant (=folder)
                     -dep1 (=folder)
                          - msg file
                          - test.doc  
- export mail items as "msg" files
- export all other non-mail items (eg contacts, office documents)
- export also folders from Public folders in outlook

I have to appologize for asking you so much, but alone nor mine colleagues  are able to accomplish this.

K regs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37820029
Not easily, apart from the VBA aspect ... easily sorted, what was the issue with the script I directed you to which takes care of recursion?

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37820085
'My' script as VBS:

Option Explicit
Dim fso

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
    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 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
                ElseIf mai.BodyFormat = 2 Then
                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".htm"), 5
                ElseIf mai.BodyFormat = 3 Then
                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".rtf"), 1
                Else
                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".msg"), 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
                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

Open in new window


Chris
0
 

Author Comment

by:DigitBoy
ID: 37821074
Hi Chris,

sorry for late response. Thank you for providing the code.

The code is exporting mail items as htm files and not as msg files. The non mail items like *.doc/xls.. are not exported.

I saw also there seems to be a problem when it has to much nested subfolders (more then 260 characters).

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37821180
>>> The code is exporting mail items as html
By default I saved mails as the format they were received as, but see below

>>> The non mail items like *.doc/xls.. are not exported.
They are in my tests albeit where mails are msg type

>>> to much nested subfolders
?If they are nested that deep in outlook then possible. If it is an error in the code then can you provide an example of the outlook folder structure and corresponding dos folder.

Option Explicit
Dim fso

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
    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 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
'                ElseIf mai.BodyFormat = 2 Then
'                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".htm"), 5
'                ElseIf mai.BodyFormat = 3 Then
'                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".rtf"), 1
                Else
                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".msg"), 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
                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

Open in new window


Chris
0
 

Author Comment

by:DigitBoy
ID: 37821472
Hi Chris,

I will try the new code and will come back to you with feedback.
This is the error message for too long Folder Long folder namenames

K rgs
0
 

Author Comment

by:DigitBoy
ID: 37821482
Wow Chris, your code exported the mail items as msg :D. Really fantastic and with right folder structure. I will test further :).
0
 

Author Comment

by:DigitBoy
ID: 37821556
Hi Chris,

I'm really amazed about your coding skills. Your code worked very well :D.
I had some error messages Maybe it is related to the following characters. I'm not sure about.
These are characters that I've found in some folders:
=¨$µ%ù@"#*/\

error:
Line 38
Char 21
Error: the operation failed
code: 80030003

The 2nd error message is long folder path.

K rgs
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 37821605
The long names are likely to be the subjects of the emails.  If you accept using something else for the subjects then maybe that will help ... for example every email has a unique id and if we use that whilst it may not be obvious from the file name what it is ... it will still have the right subject but hopefully minimise the risk of long file names ... in passing it would also fix the character issue you refer to.

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
    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 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
'                ElseIf mai.BodyFormat = 2 Then
'                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".htm"), 5
'                ElseIf mai.BodyFormat = 3 Then
'                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".rtf"), 1
                Else
'                    mai.saveas getSaveName(DOSFolderPath & "\" & FileNameCharsOnly(mai.Subject) & ".msg"), 3
					If mai.entryid <> "" Then
	                    mai.saveas getSaveName(DOSFolderPath & "\" & "Mail " & mai.entryid & ".msg"), 3
	                Else
	                MsgBox DOSFolderPath & "\" & "mail " & Date() & Int((max-min+1)*Rnd+min) & ".msg"
	                    mai.saveas getSaveName(DOSFolderPath & "\" & "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

Open in new window

0
 

Author Comment

by:DigitBoy
ID: 37821748
Hi Chris,

I verified some folders and its subfolders and their were in total more than 260 characters. To be sure I copied these with few mails (short subject) to a pst file and ran again the script and I got same error message :(.

K rgs
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 37821751
Your original request was to copy the folder structure ... if the folder structure is too long then you're going to have to compromise in order to meet the DOS limits

Chris
0
 

Author Comment

by:DigitBoy
ID: 37822677
Hi Chris,

no problem at all :). You helped us al lot with your code.
At this moment I couldn't  test the public folders to copy the folder structure. Tomorrow I will test it.

Happy easter.
0
 

Author Comment

by:DigitBoy
ID: 37822837
Hi Chris,


I've made a new question "http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_27667238.html" for long characters in outlook.

Is there any possibility to helps us further please? We know that we are asking so much from you. Our appologize for that.

K rgs
0
 

Author Closing Comment

by:DigitBoy
ID: 37824454
The code works very well to export selected folder, but for 2 error message I've got I will create another Questions.

Excellent support from Chris and superb coding skills.
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article will help to fix the below error for MS Exchange server 2010 I. Out Of office not working II. Certificate error "name on the security certificate is invalid or does not match the name of the site" III. Make Internal URLs and External…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Suggested Courses

926 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