使用 VBA 在 PST 中创建 MAPIFolder答案

【问题标题】：Create MAPIFolder in PST using VBA使用 VBA 在 PST 中创建 MAPIFolder
【发布时间】：2011-05-25 07:33:26
【问题描述】：

我正在尝试将文件夹和子文件夹的结构从一个 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 帮助、MSN 和其他人说对于 Folders.Add(Name, Type) Type 是 Optional Long。
VBA 编辑器说（键入时在工具提示中）类型是 MAPIFolder

第二次观察：但是我尝试设置 Type 参数，我收到一个错误

错误 -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 致敬

【问题讨论】：

标签： vba outlook outlook-2003

【解决方案1】：

好的解决了....问题是我只是使用了错误的枚举 :-(

在给定的Target 下创建类似于Source 类型的 MAPI 文件夹的函数如下所示：

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

【讨论】：