選択したOutlookフォルダの時計を設定するループ

Question

OutlookのVBAで次の処理を行っています。 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 

ユーザーが可変のアイテム/ Items2で指定したディレクトリにファイルを追加した場合、このコードは、ディレクトリSPATH内のコンピュータ（サブアイテム/ Items2_AddItem）にOutlookアイテムが保存されますが先頭で宣言しました。

問題は、VBAを手動で追加する必要があります。これは、アイテムが追加されたときにVBAが監視する必要があり、これらのファイルをどこに保存するかです。その結果、新しいItems変数と、すべてのフォルダに新しいItems_ItemAddサブを書き込む必要があります。

私は、次の操作を実行したい：

• 追加項目に「見」しなければならない、とフォルダはそれがOutlookの代わりに、VBAでのユーザインターフェースを介して、保存するフォルダを選択します。ユーザーは、複数のフォルダを選択する必要があります（一度に1つずつ選択する必要がある場合は気にしません）。
• 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 
  

• ユーザーは、アイテムをコンピュータに保存するフォルダを選択します。私はそれを発見したコードを使用すると、入力ファイルパスに変数を設定することができます：

  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 
  

が、私は、ユーザーが自分のマクロが設定されますするにはリボンでボタンを押したときに上記のコードを実行したいです。

ユーザーが選択したこれらのフォルダ（つまり、Sub Items_ItemAddの機能）をOutlookで監視する必要があります。これは私が立ち往生する場所です。 Outlookの終了後、ユーザーの選択肢を記憶しておく（つまり、Outlookを開くたびにユーザーがフォルダを選択する必要がないように）。

は今、次のように私の質問は以下のとおりです。

• 私はこの作品は新しい変数アイテム（i）を作成することであることを確認する一つの方法を想像して、新しいサブアイテム（i）が直接を_ItemAddユーザーがフォルダを選択してフォルダを保存するたびにVBAコードに保存されます。しかし、これはExcelではなく、Outlookで行うことが不可能であることを私は読んでいます。これは本当ですか？そうでない場合：OutlookでVBAを使用してVBAコードを作成する方法は？

• 私が想像することができる別の方法は次のとおりです。私はユーザーがテキストファイルに行った入力を保存し、テキストファイルから読み込んでそれを配列に保存します。しかし、私はコードの残りの部分で配列を使う方法を知らない。変数名を使ってSubを作成することはできないと思いますし、forループでforループに含まれる「ItemAdd」 'watcher'を使ってサブを実行して、Arrayなどのインデックスに基づいて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