複数の個人用フォルダの受信ボックスをVBA/Outlookを使って1つにまとめる

Question

VBA/Outlookを使用して多数の個人用フォルダ（Outlookに追加され、個人用フォルダと呼ばれる）を検索し、受信トレイ（フォルダは常に受信トレイと呼ばれます）を単一のPST /受信トレイ/フォルダにコピーします。個人用フォルダの数は、完了した電子メール検索（GVault）によって異なります。

個人用フォルダ - 受信トレイ、 個人用フォルダ - 受信トレイ、 個人用フォルダ - 受信トレイ、 決勝個人用フォルダ - 受信トレイ

目的は、内のすべての電子メールをユーザー1 PSTを与えることです

。これは、検索で見つかった各メールアドレスに対してフォルダ+ PSTを作成する電子メールアーカイブ検索プロセスを合理化する試みの一部です（良い古いGoogle ....）。それは明らかにすべてを1つのPSTにまとめた悪夢ですその後、ユーザーに与えます。各PSTをマスターPSTと手動で組み合わせることは可能です（Outlookを使用して）が、これはプロセスを自動化することとはまったく異なります+別個の電子メールアドレスが大量に存在する可能性があります。

元の問題はすべてのPSTを取り込んでOutlookに取り込むことでしたが、これは解決されましたが、フォーマットは上記のとおりです（別々のPSTがすべて追加されています）。

OutlookでPSTを操作するスクリプトがありますが、この最終的なハードルを乗り越えることはできません。

おかげ ダン

コードの下

Answer 1

はループがあなたの見通しcallled PSTに「受信トレイ」（いずれにせよ）というフォルダに「マスターPST」

含まれて非常に些細なエラーチェックをファイルをコピーするPSTファイルを添付します< - 無料で改善する

'include reference to Microsoft Outlook XX.0 Object Library 
Public Sub copyInbox() 
    Dim ns As Outlook.Namespace 

    On Error GoTo hell 

    Dim sourceFolder As Outlook.MAPIFolder 
    Dim copyToFolder As Outlook.MAPIFolder 
    Dim subfolder As Outlook.MAPIFolder 
    Dim objItem As Outlook.MailItem 
    Dim objItemCopy As Outlook.MailItem 
    Set ns = Application.GetNamespace("MAPI") 
    Set copyToFolder = ns.Folders("MASTER PST").Folders("Inbox") 
    'Personal folder called 'MASTER PST' with inbox subfolder must exist 
    For Each sourceFolder In ns.Folders 
     For Each subfolder In sourceFolder.Folders 
      If Trim(UCase(subfolder.Name)) = "INBOX" Then 
       For Each objItem In subfolder.Items 
        'modified below to use copy as per MSDN 
        'https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/mailitem-copy-method-outlook 
        Set objItemCopy = objItem.Copy 
        objItemCopy.Move copyToFolder 
       Next 
      End If 
      'copy items in subfolders in inbox can be added here 
     Next 
    Next 
    Exit Sub: 
hell: 
    MsgBox Err.Description, vbExclamation, Err.Source 
End Sub