Solved

Can You create Code to Save Outlook Email Messages to Sharepoint Fiscal Year Sub-Folders?

Posted on 2010-08-23
11
435 Views
Last Modified: 2012-05-10
we have separate folders for each fiscal year. remember that? So on the sharepoint root location you will see a folder for 2008, 2009, & 2010. The current fiscal year we are using right now is 2011. But we don't create a folder for that one. We just keep all the folders in the root location.

Once fiscall year 2011 is done, I will create a folder called: 2011 and then move all the current 2011 folders into it. then for fiscall year 2012 I will have the folders in the same root location as they are now for 2011. and will continue on for 2013, 1014, etc. Does that make sense?

And that is what I had mentiond earlier. But not sure if you recall.

So, what that means is if I recieve any emails that reference an "older" fiscal year project number. Like the one I got a while back: "CTH1000024" (fiscal year 2010) or "CTH0900009" (fiscal year 2009) I would need to save that email to that corrisponding fiscal year folder.

I dont' get those older emails that often but I do get them.

I noticed this was still an outstanding issue because when was testing your latest code I pulled up an email that referenced an older fiscal year in the subject line. it was a 2010 project number. so when I clicked the button instead of saving to that 2010 folder on sharepoint, it saved it to the current root location. since it didn't see a folder called: CTH100024 it created it in that location.

How much effort will it be to add code to account for the older existing fiscal folders and also future, like when I finish with these current 2011 folders and then create a new 2011 folder and move onto 2012?

see below for how the older fiscal folders look like and what the project number scheme is inside each one.
      
0
Comment
Question by:matrix0511
  • 7
  • 4
11 Comments
 

Author Comment

by:matrix0511
ID: 33501424
this question is linked to the following previous question:

ID: 26415611

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_26415611.html#a33498282
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33503124
So for any valid project number i.e. CTH1100062

CTH is a constant
11 is the fiscal year.

So if an email arrives with the current fiscal year, (rules for the fiscal year needed) it is saved as:

 "\\cth-ws01\corp\IT\Shared Documents\Project Documents\CTH1100062...fullname\CTH1100062 ... subject.msg

whereas if is not CTH1000062 then it is saved to a pre-existing subfolder off of:
\\cth-ws01\corp\IT\Shared Documents\Project Documents

It can't be that as the script ought to have seen the existing folders otherwise ... therefore is it the case that the previous fiscal years are the folders simply titled as 2009, 2010 etc?

Chris
0
 

Author Comment

by:matrix0511
ID: 33503361
Chris, Yes, CTH will always be the constant. Yes, "11" is the current fiscal year.

Yes, if email comes in with a project number that starts with "CTH11" it will save to that sub folder under:

\\cth-ws01\corp\IT\Shared Documents\Project Documents\  in the CTH1100062 folder. And any other emails with that same "CTH11" prefix in the subject line will continue to save in that same Project Documents locaiton in its own respective sub folder for 2011 FY.

However, any emails that come in with ANY OTHER Fiscal Year in the project number (for example CTH0900009 or CTH0800010 or CTH1000050) the code will need to recognize that these are NOT current fiscal year project numbers (for this year it's 2011 - "11") and then copy the email to that specific fiscal year folder and then sub folder.

And once this current FY is over. I will then create a folder called: 2011

and move all current "CTH11" folders into that 2011 folder. and then all new 2012 emails (CTH12) will then be saved in that \\cth-ws01\corp\IT\Shared Documents\Project Documents location. and it will continue that way until 2013 FY.

Does that make sense?
0
Are your AD admin tools letting you down?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33503489
Indeed you confirm my take on the change ... so can you define what you mean by fiscal year - i.e. how it is calculated?

Chris
0
 

Author Comment

by:matrix0511
ID: 33503563
Yes. Believe me, it can get confusing trying to explain how our fiscal years work.

but to put it simply, for our company, our fiscal year runs March 1st to March 1st.

so, for example, this past March 1st (3-1-2010) was the beginning of our FY 2011. Once we get to next March 1st 2011 next year, that will start our FY 2012.

Get it?? So again, instead of Jan - Dec like a normal year, it runs March 1st to March 1st of the next year.
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 33508259
In my tests the following seems to work, would you like to try it and see?

Chris
Sub Q_26408152()
Dim intIncrement As Integer
Dim fn As String
Dim ft As String
Dim fso As Object
Dim strDOSFolder As String
Dim strRootFolder As String
Dim strFYAffix As String
    
'    strRootFolder = "c:\deleteme\"
'    strRootFolder = "\\cth-ws01\corp\IT\Shared Documents\Project Documents\"
    strRootFolder = "t:\"
    If Application.Inspectors.count = 0 Then Exit Sub
    If Application.ActiveInspector.CurrentItem.Class = olMail Then
        'MsgBox "Code to follow!"
        Set fso = CreateObject("scripting.filesystemobject")
        With Application.ActiveInspector.CurrentItem
            If fnValProject(.Subject) Then
                ' If NOT the current fiscal year
                If 2000 + Mid(fnGetProject(.ConversationTopic), 4, 2) <> GetFiscalYr Then
                    strRootFolder = strRootFolder & "20" & Mid(fnGetProject(.ConversationTopic), 4, 2) & "\"
                End If
                strDOSFolder = findFuzzyFolder(strRootFolder, FileNameCharsOnly(.ConversationTopic))
                If strDOSFolder = "" Then
                    strDOSFolder = findFuzzyFolder(strRootFolder, FileNameCharsOnly(fnGetProject(.ConversationTopic)))
                    If strDOSFolder = "" Then
                        md strRootFolder & fnGetProject(.ConversationTopic), True
                        strDOSFolder = fnGetProject(.ConversationTopic)
                    End If
                End If
                fn = strRootFolder & strDOSFolder & "\" & FileNameCharsOnly(.ConversationTopic)
                ft = ".msg"
                intIncrement = 1
                Do While fso.FileExists(fn & "_" & intIncrement & ft)
                    intIncrement = intIncrement + 1
                Loop
                .saveas fn & "_" & intIncrement & ft, olMsg
            Else
                fn = InputBox("Enter the project name or cancel to exit", "No Project Recorded - enter Project Number to continue")
                If fn = "" Or (Not fnValProject(fn)) Then
                    Exit Sub
                Else
                    strDOSFolder = findFuzzyFolder(strRootFolder, fn)
                    If strDOSFolder = "" Then
                        md strRootFolder & fnGetProject(fn), True
                        strDOSFolder = fnGetProject(fn)
                        If strDOSFolder = "" Then Exit Sub
                    End If
                    fn = strRootFolder & strDOSFolder & "\" & FileNameCharsOnly(.ConversationTopic)
                    ft = ".msg"
                    intIncrement = 1
                    Do While fso.FileExists(fn & "_" & intIncrement & ft)
                        intIncrement = intIncrement + 1
                    Loop
                    .saveas fn & "_" & intIncrement & ft, olMsg
                End If
            End If
        End With
    End If
End Sub

Function fnValProject(strSubject As String) As Boolean
' Uses "Microsoft VBScript Regular Expressions" Type Library
Dim regEx As Object
    
    Set regEx = CreateObject("vbscript.regexp")
    regEx.IgnoreCase = True
    regEx.Pattern = "\bCTH[0-9]{7}"
    fnValProject = regEx.test(strSubject) = True
    
Set regEx = Nothing
End Function
Function findFuzzyFolder(dosPath As String, strFolder As String) As String
Dim fso As Object
Dim subFolder As Object

    strFolder = LCase(strFolder)
    findFuzzyFolder = ""
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.folderexists(dosPath) Then
        For Each subFolder In fso.getfolder(dosPath).subfolders
            If Len(subFolder.Name) >= Len(strFolder) Then
                If Left(LCase(subFolder.Name), Len(strFolder)) = strFolder Then
                    findFuzzyFolder = subFolder.Name
                    Exit For
                End If
            End If
        Next
    End If
    
End Function

Function md(dosPath As String, Optional createFolders As Boolean)
Dim fso As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
    
    md = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.folderexists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not fso.folderexists(rootdir) Then
            md = 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
                    md = False
                End If
            End If
        Next
        Exit Function
    End If
End Function

Function fnGetProject(strSubject As String) As String
' Uses "Microsoft VBScript Regular Expressions" Type Library
Dim regEx As Object
    
    Set regEx = CreateObject("vbscript.regexp")
    regEx.IgnoreCase = True
    regEx.Pattern = "\bCTH[0-9]{7}"
    fnGetProject = UCase(regEx.Execute(strSubject)(0))
    
Set regEx = Nothing
End Function

Public Function olNav2Folder(foldername As String, Optional CheckOnly As Boolean) As Object
Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object
Dim reqdFolder As Object
Dim arrFolders() As String
Dim nestCount As Integer
 
    On Error Resume Next
    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")
    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)
    arrFolders() = Split(foldername, "\")
    Set olApp = Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set reqdFolder = olNs.folders.item(arrFolders(0))
    For nestCount = 1 To UBound(arrFolders)
        If Not reqdFolder Is Nothing Then
            Set olFldr = reqdFolder.folders
            Set reqdFolder = olFldr.item(arrFolders(nestCount))
            If reqdFolder <> olFldr.item(arrFolders(nestCount)) Then
                If CheckOnly Then
                    Set reqdFolder = Nothing
                    Exit For
                Else
                    reqdFolder.folders.Add (arrFolders(nestCount))
                    Set olFldr = reqdFolder.folders
                    Set reqdFolder = olFldr.item(arrFolders(nestCount))
                End If
            End If
        Else
        End If
    Next
    Set olNav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNs = Nothing
    Set olFldr = Nothing
    Set reqdFolder = Nothing
End Function

Function FileNameCharsOnly(str As String) As String
Dim regEx As Object
Dim matches As Object
Dim arr() As String
Dim cnt As Integer
Dim dirColon As Boolean
    
    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 GetFiscalYr(Optional dt As Variant)
    If IsMissing(dt) Then dt = Now()
    GetFiscalYr = Year(dt) + Abs(dt >= DateSerial(Year(dt), 4, 1))
End Function

Open in new window

0
 

Author Comment

by:matrix0511
ID: 33511222
Hey, you mind if I take a few days to fully test this with multiple emails?

IN the interim, question for you. I have Word docs that have to be saved to these share point locations as well. could I copy this code into a new macro and setup a custom macro button and attach it to my menu in Word and click on it to automatically save that doc to my sharepoint location folders?

Actually I just tested and it fails. probably because the code is setup for Outlook and not Word. Huh?


Word.jpg
0
 

Author Comment

by:matrix0511
ID: 33511252
I will also have Excel Spread sheets that I will need to save as well.

Let me ask you this. could I create a couple of new Experts Exchange questions for you to work on?

You have been absolutely amazing in setting up this code and since to do this same thing in Word and Excel would probaly be easy for you given what yo have done for Outlook I would rather have you work on it vs. having to expalin to someone else from scracth.

let me know and I will create the new questions.

Thanks!
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33511322
It couldn't be used direct and would need a degree of modification to work since it is specific to emails and outlooks methods.  There are substantial differences to make it work the first time though with careful design it should be possible to use for all MS files.

Chris
0
 

Author Comment

by:matrix0511
ID: 33511507
Ok. I have created a new question regarding Word And Excel

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

ID: 26425352

Thanks Chris! I can't tell you how cool it is to have all this automated! Tremendous!!
 
0
 

Author Closing Comment

by:matrix0511
ID: 33645717
Tremendous work!!
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

Are you unable to connect or configure Hotmail email account in Microsoft Outlook 2010, 2007? Or Outlook.com emails are not downloading to Outlook? Lets’ see the problem and resolve Outlook Connector error syncing folder hierarchy (0x8004102A).
This article explains how to install and use the NTBackup utility that comes with Windows Server.
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…
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

815 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

11 Experts available now in Live!

Get 1:1 Help Now