Создание MAPIFolder в PST с помощью VBA

Question

Я пытаюсь скопировать структуру папок и подпапок из одного 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() заявление I не указывайте параметр Type вообще, создается папка с именем DefaultType olMailItem (поскольку моя корневая папка является почтовой папкой). Однако я хочу создать папку того же типа, что и исходная.

первое своеобразное наблюдение:

• VBA Помогите, MSN и другие говорят, что для Folders.Add (имя, тип) Тип опционн Long.
• VBA Редактор говорит (в подсказке при вводе) Тип является MAPIFolder

второе наблюдение: Однако я пытаюсь установить тип аргумента, я получаю сообщение об ошибке

---

Ошибка -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

Anyone помощь .... пожалуйста

вид касается MikeD

Answer 1

OK решена .... проблема была я просто использовал неправильное перечисление :-(

Функция создания 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