Loop для создания часов по выбору папок Outlook

Question

Я делаю следующее в VBA в Outlook. При перетаскивании элемента Outlook в указанную папку я сохраняю этот элемент Outlook на своем компьютере (то есть в системе подачи).

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 

Этот код сохраняет элемент Outlook, на компьютере в каталоге SPATH (подпункты/Items2_AddItem), если пользователь добавляет файл в каталог, указанный в переменной Items/Items2 объявленных в верхней части.

Проблема заключается в том, что мне нужно вручную добавить VBA, какие папки VBA должны «смотреть», когда элемент добавлен, и где сохранять эти файлы. В результате мне требуется написать новую переменную Items и новый Item_ItemAdd для каждой папки, которую у меня есть.

Я хочу сделать следующее:

• Выберите папку, которая должна быть «смотрел» для добавления пункта, и папку, в которую он должен быть сохранен, через пользовательский интерфейс в Outlook, вместо VBA. Пользователи должны выбрать несколько папок (мне все равно, нужно ли их выбирать по одному), с несколькими папками сохранения на компьютере.
• Я хочу, чтобы Outlook запоминал те варианты, которые пользователь сделал при закрытии Outlook.

Чтобы сделать его более удобным для пользователя, я подумал о следующем.

• Пользователь выбирает папку в Outlook. Код, который я нашел, что делает это: то

  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 
  

• Пользователь выбирает папку пункт должен быть сохранен на на компьютере. Код, который я нашел, что позволяет установить переменный входной 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 
  

Я хочу, чтобы приведенный выше код для запуска, когда пользователь нажимает кнопку на ленте, в которой будет установлен мой макрос.

Я хочу, чтобы Outlook просматривал эти папки, которые выбрал пользователь (т. Е. Что делает Sub Items_ItemAdd). Здесь я застреваю. Я хочу, чтобы выбор пользователя запоминался (т. Е. Пользователю не нужно выбирать свои папки при каждом открытии Outlook) после закрытия Outlook.

Теперь мои вопросы заключаются в следующем:

• Я представил один из способов, чтобы сделать эту работу, чтобы создать новую переменную Items (I) и новый подраздел Items (я) _ItemAdd напрямую в коде VBA каждый раз, когда пользователь выбирает папку и сохраняет папку. Тем не менее, я читал, что это невозможно сделать в Outlook, в отличие от Excel. Это правда? Если нет: как создать код VBA с помощью VBA в Outlook?

• Другим способом, который я могу себе представить, является следующее. Я сохраняю ввод, который пользователь внес в текстовый файл, и читаю из текстового файла и сохраняю его в массиве. Тем не менее, я не знаю, как использовать массив в остальной части моего кода. Я не думаю, что можно создать Sub с именем переменной или запустить sub с «ItemAdd» 'watcher', включенным в цикл for, который проходит через массив и создает Sub-функции на основе индекса в массиве или что-то еще как это.

Надеюсь, что кто-нибудь может мне помочь. Или знает любые другие идеи о том, как заставить мою идею работать.

Answer 1

Это не относится к тому, как вы собираете или храните различные папки, но показывает, как управлять коллекцией «наблюдаемых» папок с отдельными путями «сохранить в».

Во-первых, создать класс для управления каждой папки:

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 

Вот как вы будете использовать этот класс, чтобы создать список просмотренных Вами папки:

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