用代码访问除默认PST文件之外的其他PST数据-用folders实现

Long_III

<p>现在代码操作中</p><p>&nbsp;&nbsp;&nbsp;
Set ObjOL = CreateObject("Outlook.Application")<br/>&nbsp;&nbsp;
&nbsp; Set itmNewMail = ObjOL.CreateItem(olMailItem)<br/>&nbsp;&nbsp;&nbsp;
Set itmNewMail_Copy = CreateObject("Redemption.SafeMailItem")<br/>&nbsp;&nbsp;&nbsp;
Set olNS = ObjOL.GetNamespace("MAPI")&nbsp;&nbsp;&nbsp; '获取Namespace<br/>&nbsp;&nbsp;&nbsp;
Set dftFdr = olNS.GetDefaultFolder(16)&nbsp;&nbsp;&nbsp; '获取草稿箱接口</p><p>
这些都是针对默认的PST文件的，我的邮箱里还有一个其他的PST数据文件，请问如何访问？</p>

[ 本帖最后由 Long_III 于 2008-11-26 15:47 编辑 ]

Long_III

直接用folders来访问，自己看帮助，试验出来的，供参考
Sub get_address()    '用folders来访问非默认的PST文件里的联系人
    Dim myOL As New Outlook.Application
    Dim MyNS As NameSpace
    Dim Myfolders As Folders
    Dim MyContacts

    Dim ff    'As DistListItem

    Set MyNS = myOL.GetNamespace("MAPI")

    'Set Myfolders = MyNS.Folders("BDO-tax").Folders '默认的PST文件
    Set Myfolders = MyNS.Folders("BDO-accounting").Folders    '其他的PST文件

    For Each f In Myfolders    'PST文件里的所有文件夹
        Debug.Print f.Name
    Next

    Set MyContacts = Myfolders("联系人").Items

    On Error Resume Next
    For Each ff In MyContacts
        m = m + 1
        If TypeName(ff) = "ContactItem" Then    '联系人
            Debug.Print m, ff.Email1Address, ff.FullName
        ElseIf TypeName(ff) = "DistListItem" Then    '联系人组
            Debug.Print m, ff.Subject
        End If
    Next

    Set MyContact = Nothing
    Set MyNS = Nothing
End Sub


Sub get_folders() '所有的文件夹
    Dim myOL As New Outlook.Application
    Dim MyNS As NameSpace

    Set MyNS = myOL.GetNamespace("MAPI")

    For Each f In MyNS.Folders
        Debug.Print f.Name
        For Each ff In f.Folders
            Debug.Print "  " & ff.Name
            For Each fff In ff.Folders
                Debug.Print "    " & fff.Name
            Next
        Next
    Next
End Sub