它最终得到了我必须寻求帮助的地步。
由于电子邮件服务器的空间限制,我们公司通常会将邮件/日历等备份从Outlook备份到PST文件。
我们现在不再有在电子邮件服务器上预先设置的空间限制,因此我们希望将PST文件中的所有信息都放入用户邮箱。
最终我们希望运行一个vbscript或类似的搜索用户本地驱动器,发现任何PST文件,然后将所有数据传输到名为" Imported"的文件夹下的交换邮箱。然后删除PST。
理想情况下,我们只需通过PShell直接在没有用户的情况下执行此操作,但是因为大多数用户都拥有"很多" PST文件,其中大部分都不是必需的,如果我们全部完成,将会填满我们的交换。
我完全不了解Outlook VBA,所以这是我需要帮助的唯一部分。我花了一些时间在搜索结果中工作,希望看到我可以让它工作,但无法让它工作。
我在这方面做了几次尝试。这是我目前的代码:
' 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
目前完整的脚本如下所示
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
经过测试,导入的文件夹已在收件箱中成功创建。
PST作为商店添加,重命名也可以。
但是,它似乎是脚本的循环/下一部分失败。没有项目移动到Imported文件夹。
我想我们可能没有选择邮箱中的项目。我们是否需要指定另一个&#34;文件夹()&#34;在那里?
理想情况下,我们希望移动PST中的任何办公室内容。有谁知道日历条目是否会被复制作为其中的一部分。
我们是否需要指定例如,获取所有邮件并移动然后获取所有联系人并移动,获取所有日历条目并移动?
答案 0 :(得分:2)
“无法使其正常工作”您没有描述问题,但这里有一些建议。
在创建文件夹时添加一行来设置objDestFolder。
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
或始终尝试在主收件箱中创建“已导入”文件夹
' 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")
用这样的东西替换While Wend。
For i = PSTInboxItemsCount To 1 Step -1
objPSTInboxItems(i).Move objDestFolder
Next i
答案 1 :(得分:2)
搞定了
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