Solved

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

Posted on 2010-08-23
11
431 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
 
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
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

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

Find out how to use Active Directory data for email signature management in Microsoft Exchange and Office 365.
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
The basic steps you have just learned will be implemented in this video. The basic steps are shown to configure an Exchange DAG in a live working Exchange Server Environment and manage the same (Exchange Server 2010 Software is used in a Windows Ser…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

759 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

19 Experts available now in Live!

Get 1:1 Help Now