Solved

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

Posted on 2012-04-06
19
1,251 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
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
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…

821 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