Kombinieren mehrere persönliche Ordner Posteingänge in einen mit VBA/Outlook

Question

Ich frage mich, ob es eine Möglichkeit gibt, mit VBA/Outlook durch eine Reihe von persönlichen Ordnern (alle zu Outlook und persönlichen Ordnern) und kopieren Sie den Inhalt der Posteingänge (der Ordner wird immer als Posteingang bezeichnet) in einen einzigen PST/Posteingang/Ordner. Die Anzahl der persönlichen Ordner hängt von der abgeschlossenen E-Mail-Suche ab (GVault).

Persönliche Ordner - Posteingang, Persönliche Ordner - Posteingang, Persönliche Ordner - Posteingang, Finale Persönliche Ordner - Posteingang

Ziel ist es in dem Benutzer ein PST mit allen E-Mails zu geben

. Dies ist Teil eines Versuches, unseren E-Mail-Archivsuchprozess zu rationalisieren, der für jede gefundene E-Mail-Adresse einen Ordner + PST erstellt (guter alter Google ....). Es ist offensichtlich ein Albtraum, sie alle in einem PST zu kombinieren dann gib es einem Benutzer. Es ist möglich (mit Outlook), jede PST manuell mit einem Master-PST zu kombinieren, aber dies ist weit davon entfernt, den Prozess zu automatisieren + es könnte eine große Anzahl von separaten E-Mail-Adressen geben.

Das ursprüngliche Problem war, alle PSTs zu nehmen und sie in Outlook zu bekommen, dies wurde gelöst, aber das Format ist wie oben beschrieben (separate PSTs alle hinzugefügt).

Jede Hilfe würde sehr geschätzt werden, da ich nicht über diese letzte Hürde hinauskommen kann, gibt es Skripte, die PSTs in Outlook manipulieren, sie tun dies einfach nicht.

Dank Dan

Answer 1

Im Folgenden Code PST Ihre Outlook angebracht Loop-Dateien Dateien in einem Ordner namens 'Posteingang' (jedenfalls) an die PST callled 'Master PST'

inklusive sehr trivial Fehlerprüfung Kopieren < - frei zu verbessern

'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