Создать MAPIFolder в PST, используя VBA - PullRequest
Новая
       37

Создать MAPIFolder в PST, используя VBA

0 голосов
/ 14 декабря 2010

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

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

  • Справка VBA, MSN и другие говорят, что для Folders.Add (Name,Тип) Тип является необязательным Long.
  • Редактор VBA говорит (во всплывающей подсказке при наборе текста) Тип - это MAPIFolder

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

Кто-нибудь поможет .... пожалуйста

С уважением, MikeD

1 Ответ

0 голосов
/ 21 марта 2011

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

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