Импорт календарей / контактов из PST - Outlook VBA - PullRequest
Новая
       8

Импорт календарей / контактов из PST - Outlook VBA

0 голосов
/ 05 ноября 2018

Я пытался написать какой-нибудь VBA для автоматизации перехода IMAP от одного провайдера к другому. У меня есть экспорт контактов и календарей из текущего почтового ящика в PST. Я пытаюсь импортировать их в новый профиль Outlook, контакты и календари. Однако с кодом, с которым я пытался работать, я получаю либо «Объект не поддерживает эту функцию», либо он выдает ошибку при «пошаговом» прохождении части. Мне удалось получить код для записи контактов / календарей в импортированную папку, но не в саму папку профиля. Я не чувствую, что шаг «Для каждого» в конце подходит для перехода по контактам, но попытка подсчета для объектов, похоже, тоже не делает этого.

Любая помощь будет оценена. 

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
...