Verschieben Sie alle Elemente aus einer PST-Datei

Question

Es ist schließlich an den Punkt, wo ich um Hilfe bitten muss.

In unserer Firma war es gängige Praxis, aufgrund von Platzbeschränkungen auf dem E-Mail-Server Sicherungskopien von Mail/Kalender usw. von Outlook auf PST-Dateien zu erstellen.

Wir haben keine Platzbeschränkungen mehr, die dies jetzt auf dem E-Mail-Server verhindern, also möchten wir alle Informationen in den PST-Dateien in das Benutzerpostfach holen.

Schließlich hoffen wir, ein VBScript oder ähnliches, die lokalen Laufwerke der Benutzer suchen, PST-Dateien zu entdecken, und dann alle Daten an die Exchange-Mailbox in einem Ordner namens "Importierte" übertragen und löschen Sie dann die PST .

Idealerweise würden wir dies einfach über PShell direkt mit Exchange ohne den Benutzer tun, aber da die meisten Benutzer "viele" PST-Dateien haben, sind die meisten nicht erforderlich und würden unseren Austausch füllen, wenn wir sie alle hätten.

Ich weiß nicht Outlook VBA überhaupt, so dass der einzige Teil ist, mit dem ich Hilfe brauche. Ich habe eine Weile damit verbracht, mich durch die Suchergebnisse zu arbeiten, in der Hoffnung zu sehen, dass ich das funktionieren lassen kann, aber es funktioniert nicht.

Ich hatte mehrere verschiedene Versuche an diesem. Dies ist der aktuelle Code, den ich habe:

' Get the main Inbox folder 
Const OLInbox = 6 'Inbox Items folder 
Set objOutlook = CreateObject("Outlook.Application") 
Set objNameSpace = objOutlook.GetNamespace("MAPI") 

Set objInbox = objNameSpace.GetDefaultFolder(OLInbox) 'sets objFolder to the Inbox for it's reference 

' Create the Imported folder in the main inbox 
On Error Resume Next 
Set objDestFolder = objInbox.Folders("Imported") 
If Err.Number <> 0 Then 
    Set objNewFolder = objInbox.Folders.Add("Imported") 
End If 
On Error Goto 0 



' Add the PST to Outlook 
objNamespace.AddStore ("d:\backup.pst") 

' Select the new store 
Set objPST = objNamespace.Folders.GetLast 
' Rename the Store To be easier To use 
objPST.Name = "PSTImport" 

' disconnect and reconnect the store to force a refresh of the folder list 
objNamespace.RemoveStore objPST 
objNamespace.AddStore ("d:\backup.pst") 


Set objPSTInbox = objOutlook.Session.Folders("PSTImport").Folders("Inbox") 

'Set objPSTFolder = objNameSpace.Folders("PSTImport").Folders("Inbox") 
Set objPSTItems = objPSTInbox.Items 

While TypeName(objPSTItems) <> "Nothing" 
    objPSTItems.Move objDestFolder 
    Set objPSTItems = objPSTItems.FindNext 
Wend 

---

Derzeit ist das vollständige Skript wie diese

Set objShell = WScript.CreateObject ("WScript.Shell") 

' Get the main Inbox folder 
Const OLInbox = 6 'Inbox Items folder 
Set objOutlook = CreateObject("Outlook.Application") 
Set objNameSpace = objOutlook.GetNamespace("MAPI") 

Set objInbox = objNameSpace.GetDefaultFolder(OLInbox) 'sets objFolder to the Inbox for it's reference 

' Create the Imported folder in the main inbox 
On Error Resume Next 
Set objDestFolder = objInbox.Folders("Imported") 
If Err.Number <> 0 Then 
    Set objNewFolder = objInbox.Folders.Add("Imported") 
    Set objDestFolder = objInbox.Folders("Imported") 
End If 
On Error Goto 0 



' Add the PST to Outlook 
objNamespace.AddStore ("d:\backup.pst") 

' Select the new store 
Set objPST = objNamespace.Folders.GetLast 
' Rename the Store To be easier To use 
objPST.Name = "PSTImport" 

' disconnect and reconnect the store to force a refresh of the folder list 
objNamespace.RemoveStore objPST 
objNamespace.AddStore ("d:\backup.pst") 


Set objPSTInbox = objOutlook.Session.Folders("PSTImport").Folders("Inbox") 

Set objPSTInboxItems = objPSTInbox.Items 
PSTInboxItemsCount = objPSTInboxItems.count 

For i = PSTInboxItemsCount To 1 Step -1 
    objPSTInboxItems(i).Move objDestFolder 
Next 

Beim Testen sieht, der importierte Ordner im Posteingang erfolgreich erstellt.

Die PST wird als Speicher hinzugefügt und die Umbenennung funktioniert auch.

Es scheint jedoch, dass die Schleife/der nächste Teil des Skripts fehlschlägt. Keine Elemente werden in den Ordner "Importiert" verschoben.

Ich denke, wir können nicht die Elemente in der Mailbox auswählen. Müssen wir dort einen anderen "folders()" Abschnitt angeben?

Idealerweise möchten wir alle Office-Inhalte in der PST verschieben. Weiß jemand, ob Kalendereinträge als Teil davon kopiert werden?

Möchten wir zum Beispiel angeben, alle Mails abrufen und verschieben, dann alle Kontakte abrufen und verschieben, alle Kalendereinträge abrufen und verschieben?

Answer 1

Verstanden

Set objShell = WScript.CreateObject ("WScript.Shell") 

' Get the main Inbox folder 
Const OLInbox = 6 'Inbox Items folder 
Set objOutlook = CreateObject("Outlook.Application") 
Set objNameSpace = objOutlook.GetNamespace("MAPI") 

Set objInbox = objNameSpace.GetDefaultFolder(OLInbox) 'sets objFolder to the Inbox for it's reference 

' Create the Imported folder in the main inbox 
On Error Resume Next 
Set objDestFolder = objInbox.Folders("Imported") 
If Err.Number <> 0 Then 
    Set objNewFolder = objInbox.Folders.Add("Imported") 
    Set objDestFolder = objInbox.Folders("Imported") 
End If 
On Error Goto 0 


' Run the sub 
sbImportPST ("d:\backup.pst") 


Sub sbImportPST (strPSTLocalPath) 
    ' Add the PST to Outlook 
    objNamespace.AddStore (strPSTLocalPath) 

    ' Select the new store 
    Set objPST = objNamespace.Folders.GetLast 
    ' Rename the Store To be easier To use 
    objPST.Name = "PSTImport" 

    ' disconnect and reconnect the store to force a refresh of the folder list 
    objNamespace.RemoveStore objPST 
    objNamespace.AddStore (strPSTLocalPath) 

    ' Get the mail items in the top level - in most cases this will not be needed as mails will be in the "inbox" folder under this folder 
    Set objPSTInbox = objOutlook.Session.Folders("PSTImport") 
    Set objPSTInboxItems = objPSTInbox.Items 
    PSTInboxItemsCount = objPSTInboxItems.count 
    ' Step through all items just discovered and move to Imported Folder 
    For i = PSTInboxItemsCount To 1 Step -1 
     objPSTInboxItems(i).Move objDestFolder 
    Next 

    ' Step through all subfolders of the PST (this wilkl include the folder "calendar" and "contacts" and "Inbox") and move the folder. 
    Set oFolders = objPSTInbox.Folders 
    For i = oFolders.Count To 1 Step -1 
     oFolders.Item(i).MoveTo objDestFolder 
    Next 

    ' Remove the PST file from Outlook 
    objNamespace.RemoveStore objPST 
End Sub 

Answer 2

"kann es nicht funktionieren" Sie haben das Problem (s) nicht beschrieben, aber hier sind einige Vorschläge.

Fügen Sie eine Zeile hinzu, um objDestFolder beim Erstellen des Ordners festzulegen.

On Error Resume Next 
Set objDestFolder = objInbox.Folders("Imported") 
If Err.Number <> 0 Then 
    Set objNewFolder = objInbox.Folders.Add("Imported") 
    Set objDestFolder = objInbox.Folders("Imported") 
End If 
On Error Goto 0 

Oder immer versuchen, den importierten Ordner in der Haupt Posteingang

' Bypass the error if the folder exists 
On Error Resume Next 
Set objDestFolder = objInbox.Folders.add("Imported") 
On Error GoTo 0 
Set objDestFolder = objInbox.Folders("Imported") 

Ersetzen Sie die While Wend mit so etwas zu schaffen.

For i = PSTInboxItemsCount To 1 Step -1 
    objPSTInboxItems(i).Move objDestFolder 
Next i