Создать MapFolder в PST с помощью VBA
-
09-10-2019 - |
Вопрос
Я пытаюсь скопировать структуру папок и подпапки из одного Outlook PST на другой и испытываю трудности с Folders.Add()
утверждение:
Private Sub Process(S As MAPIFolder, T As MAPIFolder, RootLevel As Boolean, BeforeDate As Date)
Dim N As NameSpace, F As MAPIFolder, G As MAPIFolder
' S is source folder (parameter)
' T is target folder (parameter)
' F is current source subfolder for recursion (private)
' G is target folder for recursion (private)
Set N = Application.GetNamespace("MAPI")
' recurse through subfolders
For Each F In S.Folders
If F.Items.Count <> 0 Or F.Folders.Count <> 0 Then ' process only if items or subfolders found
If FoundFolder(T, F) Then ' this function works fine
Set G = T.Folders(F.Name) ' found - just assign
Else
Set G = T.Folders.Add(F.Name, N.GetDefaultFolder(F.DefaultItemType)) ' not found - create
End If
'
' more code (working well)
'
' process next level without Root flag
Process F, G, False, BeforeDate
End If
Next F
Set F = Nothing
Set G = Nothing
End Sub
Пока в Folders.Add()
Заявление я не указываю Type
Параметр вообще создается папка с defaulttype olmailitem (потому что моя корневая папка оказалась почтовой папкой). Тем не менее, я хочу создать папку того же типа, что и исходная папка.
Первое своеобразное наблюдение:
- VBA Help, MSN и другие говорят, что для FOLDERS.Add (имя, тип) тип необязательно длинным.
- Редактор VBA говорит (в подсказывании инструментов при наборе) тип является MapFolder
2 -е наблюдение: однако я пытаюсь установить аргумент типа, я получаю ошибку
Ошибка -2147024809 (80070057)
Не удалось завершить операцию. Одно или несколько значений параметров недопустимы
Я попробовал следующее
' Type as Long
Set G = T.Folders.Add(F.Name, 0)
Set G = T.Folders.Add(F.Name, olMailItem)
Set G = T.Folders.Add(F.Name, OlItemType.olMailItem)
Set G = T.Folders.Add(F.Name, F.DefaultItemType) ' this is what I actually want
' Type as MAPIFolder
Set G = T.Folders.Add(F.Name, F)
Set G = T.Folders.Add(F.Name, N.GetDefaultFolder(F.DefaultItemType))
Ошибка - ошибка - ошибка
Что делать, чтобы создать папку того же типа, что и исходная папка f
Кто -нибудь помогает .... пожалуйста
С уважением, Микед
Решение
ОК Решено .... Проблема была в том, что я просто использовал Неправильное перечисление :-(
Функция, создавая папку MAPI типа, похожая на Source
ниже данного Target
Похоже:
Private Function CreateFolderOfType(Source As MAPIFolder, Target As MAPIFolder) As MAPIFolder
Dim F As MAPIFolder
Set CreateFolderOfType = Nothing
' if source already exists below Target
For Each F In Target.Folders
If F.Name = Source.Name Then
Set CreateFolderOfType = F
Exit Function
End If
Next F
Select Case Source.DefaultItemType
Case olAppointmentItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderCalendar)
Case olContactItem, olDistributionListItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderContacts)
Case olJournalItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderJournal)
Case olMailItem, olPostItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderInbox)
Case olNoteItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderNotes)
Case olTaskItem
Set CreateFolderOfType = Target.Folders.Add(Source.Name, olFolderTasks)
Case Else
Set CreateFolderOfType = Target.Folders.Add(Source.Name)
End Select
End Function