Question

我一直在尝试编写一些VBA，以自动执行从一个提供程序到另一个提供程序的IMAP迁移。我已经将联系人和日历从当前邮箱导出到PST中。我想做的就是将这些导入新的Outlook配置文件，联系人和日历中。但是，使用我一直尝试使用的代码，我得到了“对象不支持此功能”，或者在“逐步执行”部分出现了错误。我能够获得将联系人/日历写到导入文件夹，而不写到实际个人资料文件夹的代码。我觉得最后的For Each步骤不适合逐步浏览联系人，但是尝试对对象进行计数，似乎也没有。

任何帮助将不胜感激。

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

' Get the main Inbox folder
Const OLInbox = 6    'Inbox Items folder
Const olFolderContacts = 10 'Contacts
Set objOutlook = CreateObject( "Outlook.Application" )
Set objNameSpace = objOutlook.GetNamespace( "MAPI" )
Set objInbox = objNameSpace.GetDefaultFolder( OLInbox ) 'sets objFolder to the Inbox for it's reference
Set objcontactDestFolder = objNamespace.GetDefaultFolder(olFolderContacts) 
Set objcalendarDestFolder = objNamespace.GetDefaultFolder(olFolderCalendar) 

' 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 ("C:\temp\Outlook Export.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"

objNamespace.RemoveStore objPST
objNamespace.AddStore (strPSTLocalPath)


Set objPSTInbox = objOutlook.Session.Folders("PSTImport1")
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 objInbox
Next 

Set oFolders = objPSTInbox.Folders("Contacts") 
For Each objContact In oFolders 
    oFolders.Item.MoveTo objcontactDestFolder
Next 

Set oFolders = objPSTInbox.Folders("Calendar") 
For Each objAppointment In oFolders 
    oFolders.Item.MoveTo objcontactDestFolder
Next 
' Remove the PST file from Outlook
objNamespace.RemoveStore objPST
End Sub

从PST导入日历/联系人-Outlook VBA

0 个答案: