Hi all!
I've never used VBA for Outlook. I have found various snippets of code on the above on this site, but I have absolutely no idea how to make it work to my specific situation. I've been cracking my head and losing sleep over this for over a week now, so thought it's time I asked for help
Some Background Information
- My colleagues send and receive a massive amount of emails a day
- They file these sent and received emails together with attachments into a single project sub folder on Outlook
- When they eventually get to filing the emails on the server, the sent emails together with the attachments gets saved in the project folder (outgoing sub folder) and the incoming emails and attachments get saved in the project folder (incoming sub folder)
- At the moment, they manually copy each email into the respective sub folder on the server and manually rename them in accordance with our naming conventions
As you can appreciate, this is a very silly and unproductive way of doing things when I know that Outlook is capable of automating this whole process although I have no clue how. This also explains why the electronic filing is the bane of my colleagues' lives and why their emails end up clogged.
What I would like to Achieve
At the end of the day, with a click of a button, to be able to perform the following:
For each project sub folder on Outlook:
- Save all incoming emails including attachments into the specified folder on the server in accordance with the naming convention (ProjectNo & " " & " " & Date in YYMMDD & " " & Email Subject
- Save all outgoing emails including attachments into the specified folder on the server in accordance with the naming convention (ProjectNo & " " & " " & Date in YYMMDD & " " & Email Subject
- Empty the project sub folder in Outlook
This is what I've got so far - It is far from complete, but I thought it better to work on getting smaller chunks working at a time.
Code:
Sub ElectronicFiling()
Call LoopInboxFolders
End Sub
Sub ProjYear()
Dim ns As Outlook.NameSpace
Dim myfolder As Outlook.Folder
Dim mysubfolder As Outlook.Folder
Dim strProjYear As String
Dim strProjYr As String
Set ns = Application.GetNamespace("MAPI")
Set myfolder = ns.GetDefaultFolder(olFolderInbox)
Set mysubfolder = myfolder.Folders
strProjYr = Left(mysubfolder.Name, 2)
strProjYear = "20" & strProjYr
End Sub
Sub CorrInOut()
Dim iItem As Long
Dim strAddress As String
Dim strCorr As String
With Outlook.ActiveExplorer.Selection
strAddress = .Item(iItem).SenderEmailAddress
If strAddress Like "*@gascoigneconsultants.com" Then
'Sender is internal therefore email is outgoing
strCorr = "Out"
Else
strCorr = "In"
End If
End With
End Sub
Sub SavePath()
Dim strSavePath As String
Call ProjYear
Call CorrInOut
strSavePath = "G:\" & strProjYear & "\Projects\" & mysubfolder.Name & "\Correspondence\" & strCorr
End Sub
Sub LoopInboxFolders()
Dim ns As Outlook.NameSpace
Dim myfolder As Outlook.Folder
Dim mysubfolder As Outlook.Folder
Set ns = Application.GetNamespace("MAPI")
'Get the default inboxfolder
Set myfolder = ns.GetDefaultFolder(olFolderInbox)
'Loop through each folder and display name of the folder
For Each mysubfolder In myfolder.Folders
Call SavePath
MsgBox mysubfolder.Name
MsgBox strSavePath
Next mysubfolder
End Sub
I have ensured that macros are enabled in Outlook 2007 however nothing happens when I run the main macro which is ElectronicFiling.
Can anyone please tell me where I've gone wrong?
Thanks heaps!
dBforums
>
Trying to Automate Outlook for Electronic Filing
11-05-11, 22:13
Linear Mode
