Loop to set up watches on a selection of Outlook folders

Question

I'm doing the following in VBA in Outlook. Upon dragging an Outlook item to a specified folder, I save this Outlook item to my computer (i.e. a filing system).

Private WithEvents Items As Outlook.Items
Private WithEvents Items2 As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderInbox).Parent.Folders("Hello").Items
  Set Items2 = Ns.GetDefaultFolder(olFolderInbox).Parent.Folders("Bye").Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then

  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String
  Dim enviro As String

  enviro = CStr(Environ("USERPROFILE"))

  sName = Item.Subject
  ReplaceCharsForFileName sName, "_"

  dtDate = Item.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, " - hhnn ", _
    vbUseSystemDayOfWeek, vbUseSystem) & "- " & sName & ".msg"

  sPath = "Y:\BM_Clientenmap\D\Hello\emails\"
  Debug.Print sPath & sName
  Item.SaveAs sPath & sName, olMSG

  End If

End Sub

Private Sub Items2_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then

  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String
  Dim enviro As String

  enviro = CStr(Environ("USERPROFILE"))

  sName = Item.Subject
  ReplaceCharsForFileName sName, "_"

  dtDate = Item.ReceivedTime
  sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, " - hhnn ", _
    vbUseSystemDayOfWeek, vbUseSystem) & "- " & sName & ".msg"

  sPath = "Y:\BM_Clientenmap\D\Bye\emails\"
  Debug.Print sPath & sName
  Item.SaveAs sPath & sName, olMSG

  End If

End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub

This code saves an Outlook item to the computer in directory sPath (Sub Items/Items2_AddItem), if the user adds a file to the directory specified in the variable Items/Items2 declared at the top.

The problem is it requires me to manually add in VBA which folders VBA should "watch" when an item is added, and where to save these files. As a result, it requires me to write a new Items variable and new Items_ItemAdd sub for every folder I have.

I want to do the following:

Select the folder that should be "watched" for an item added, and the folder to which it should be saved, through user interface in Outlook instead of VBA. Users should select multiple folders (I don't care if they have to select them one at a time), with multiple save folders on the computer.
I want Outlook to remember the choices that the user made upon closing Outlook.

To make it more user friendly, I thought about the following.

User selects folder in Outlook. Code that I found that does this:

Set FSO = CreateObject("Scripting.FileSystemObject")
Set myOlApp = Outlook.Application
Set iNameSpace = myOlApp.GetNamespace("MAPI")
Set ChosenFolder = iNameSpace.PickFolder
If ChosenFolder Is Nothing Then
GoTo ExitSub:
End If

User then selects the folder the item should be saved to on computer. Code that I found that allows you to set a variable to an input filepath:

Function BrowseForFolder(StrSavePath As String, Optional OpenAt As String) As String
Dim objShell As Object
Dim objFolder '  As Folder

Dim enviro
enviro = CStr(Environ("USERPROFILE"))
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please choose a folder", 0, 
enviro & "\Computer\")
StrSavePath = objFolder.self.Path

On Error Resume Next
On Error GoTo 0

ExitFunction:
Set objShell = Nothing

End Sub

I want the above code to run when the user presses a button in the ribbon to which my macro would be set.

I want Outlook to watch these folders that the user has selected (i.e. what Sub Items_ItemAdd does). This is where I get stuck. I want the choices of the user to be remembered (i.e. so the user doesn't have to select his folders every time he opens Outlook) after Outlook is closed.

Now my questions are as follows:

I imagined one way to make this work is to create a new variable Items(i) and a new Sub Items(i)_ItemAdd directly in the VBA code every time the user selects the folder and save folder. However, I read this is impossible to do in Outlook, unlike in Excel. Is this true? If not: how to create VBA code using VBA in Outlook?
Another way I can imagine is the following. I save the input that the user made to a text file, and I read from the text file and save that to an array. However, I do not know how to use the array in the rest of my code. I do not think it's possible to create a Sub with a variable name, or run a sub with "ItemAdd" 'watcher' included in a for-loop that runs through the array and creates Sub functions based on the index in the Array or something like that.

Hope anyone can help me. Or knows any other ideas on how to make my idea work.

Tim Williams · Accepted Answer · 2017-02-17T01:17:57.700

1

This doesn't address how you collect or store the various folders, but shows how to manage a collection of "watched" folders with separate "save to" paths.

First, create a class to manage each folder:

Option Explicit

Private OlFldr As Folder
Private SavePath As String
Public WithEvents Items As Outlook.Items

'called to set up the object
Public Sub Init(f As Folder, sPath As String)
    Set OlFldr = f
    Set Items = f.Items
    SavePath = sPath
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
       'Just a simple message to show what's going on.
       'You can add code here to save the item, or you can pass
       '  arguments to a common sub defined in a regular module
       MsgBox "Mail '" & Item.Subject & "' was added to Folder '" & OlFldr.Name & _
              "' and will be saved to '" & SavePath & "'"
  End If
End Sub

Here's how you'd use that class to set up your watched folders:

Option Explicit

Dim colFolders As Collection '<< holds the clsFolder objects

Private Sub SetupFolderWatches()

    'This could be called on application startup, or from the code which collects
    '  user selections for folders/paths

    Dim Ns As Outlook.NameSpace, inboxParent, arrFolders, f, arr
    Set Ns = Application.GetNamespace("MAPI")

    Set colFolders = New Collection
    Set inboxParent = Ns.GetDefaultFolder(olFolderInbox).Parent

    'you'd be reading this info from a file or some other storage...
    arrFolders = Array("Test1|C:\Test1_Files\", "Test2|C:\Test2_Files\")

    For Each f In arrFolders
        arr = Split(f, "|")
        colFolders.Add GetFolderObject(inboxParent.Folders(arr(0)), CStr(arr(1)))
    Next f

End Sub


'"factory" function to create folder objects
Function GetFolderObject(foldr As Folder, sPath As String)
    Dim rv As New clsFolder
    rv.Init foldr, sPath
    Set GetFolderObject = rv
End Function

edited Feb 17 '17 at 01:17

answered Feb 16 '17 at 18:33

Tim Williams

154,628
8
97
125

Hi Tim, Many thanks, this code helps me a lot in my thinking process. I thought about creating each "watch" in a loop, but I was wondering whether this is possible in VBA and if you could give a hint in how to make this? As the AddItem "watch" is part of a sub/function name and as far as I know it it's not possible to create functions on the fly in VBA, how can I create new "watch" functions as I loop through e.g. an array? – Jack Spar Feb 16 '17 at 19:13
I updated my answer to show creating watches in a loop. Note you don't need to create a new sub to export each folder: you can either add the full export code in the class module, so each object can perform its own exporting (based on the arguments passed to `Init`), or you can add an "ExportItem" Sub in a regular module which you can call from the class instances, passing the item to be exported and the destination folder path. – Tim Williams Feb 17 '17 at 01:20
Great thanks! One more thing I was wondering: in this code we use the syntax `Set inboxParent = Ns.GetDefaultFolder(olFolderInbox).Parent` Next, in the array we pass this to the GetFolderObject function. If I use this code, this only works if the folder is a direct sister (i.e. not a subfolder) of the inbox folder. Is there any way to make this dynamic so that every folder can be choosen? I was able to do this by e.g. letting the user select a folder, and then passing that folder as an argument to GetFolderObject, but this can´t be written (and subsequently read from) a text file. – Jack Spar Feb 17 '17 at 08:42
I believe I found a solution but please correct me if I´m not being efficient. Steps: -> Let user select a folder -> save as String with FolderPath property -> save to text file -> read from text file (upon loading Outlook) -> Convert FolderPath String to Folder Object using a function -> Pass Folder Object as argument to GetFolderObject function. I haven't written the code yet, but systematically this should work right? – Jack Spar Feb 17 '17 at 13:24
Yes that sounds like a reasonable approach – Tim Williams Feb 17 '17 at 15:54
Just wanted to note that I completed the macro. It works like a charm :) Thank you once again! – Jack Spar Feb 28 '17 at 08:45
Good to hear you figured it all out! – Tim Williams Feb 28 '17 at 15:37

Loop to set up watches on a selection of Outlook folders

1 Answers1

Linked