在Outlook2010中有多个账户（邮箱），如何用VBA列出所有的这些账户名称

FENGJUN

在Outlook2010中有多个账户（邮箱），如何用VBA列出所有的这些账户名称，以及其下收件箱中的邮件标题？

[ 本帖最后由 FENGJUN 于 2011-3-29 13:40 编辑 ]

dsd999

你的目的是什么？

用某个账户发邮件？

FENGJUN

原帖由 dsd999 于 2011-3-29 14:39 发表
你的目的是什么？

用某个账户发邮件？

dsd999版主，有礼了，请教如下：
更为明确的需求：如何列出所有账户（邮箱）的收件箱中的邮件标题？
比如，我的Outlook中就设置了三个邮箱，怎样用VBA一次性列出这几个邮箱的收件箱中的邮件标题呢？

dsd999

你的意思是列出你截图中的hr2*** 和 ***sina里收件箱中的邮件标题？

我理解的对不对？

FENGJUN

是这个意思，当然是个通用的代码，别的电脑都能用

dsd999

试试

Sub ListMailSubject()
  On Error Resume Next
    Dim olApp As Outlook.Application
    Dim nmsName As NameSpace
    Dim fldFolder As MAPIFolder
    Dim subFolder As MAPIFolder
    Dim objitem As Object
   
    Set olApp = Outlook.Application
    Set nmsName = olApp.GetNamespace("MAPI")
   
    For Each fldFolder In nmsName.Folders
      Debug.Print fldFolder.Name
       For Each subFolder In fldFolder.Folders
        If (subFolder.Name = "Inbox") Then
        For Each objitem In subFolder.Items
                If objitem.Class = olMail Then
                 Debug.Print objitem.Subject
                End If
        Next
        End If
       Next
    Next

End Sub

FENGJUN

原帖由 dsd999 于 2011-3-30 11:00 发表
试试

Sub ListMailSubject()
  On Error Resume Next
    Dim olApp As Outlook.Application
    Dim nmsName As NameSpace
    Dim fldFolder As MAPIFolder
    Dim subFolder As MAPIFolder
    Dim obj ...

非常感谢版主大人，代码很漂亮，问题得以解决：
我的是中文邮箱，微调一下：
Sub ListMailSubject()
'列出所有账户的收件箱中的邮件标题
    On Error Resume Next
    Dim olApp As Outlook.Application
    Dim nmsName As Namespace
    Dim fldFolder As MAPIFolder
    Dim subFolder As MAPIFolder
    Dim objitem As Object
    Dim i As Integer

    Set olApp = Outlook.Application
    Set nmsName = olApp.GetNamespace("MAPI")

    For Each fldFolder In nmsName.Folders
        '        Debug.Print fldFolder.Name
        If fldFolder.Name = "hr2@zibolan.com" Then
            For Each subFolder In fldFolder.Folders
                If (subFolder.Name = "收件箱") Then
                    For Each objitem In subFolder.Items
                        If objitem.Class = olMail Then
                            '                 Debug.Print objitem.Subject
                            Cells(2, 1).Offset(i, 1).Value = objitem.Subject
                            i = i + 1
                        End If
                    Next
                End If
            Next
        End If
    Next
End Sub

[ 本帖最后由 FENGJUN 于 2011-3-31 13:48 编辑 ]

FENGJUN

还有个问题请教，如何用代码批量标记这些邮件为“已读”呢？

dsd999

objitem.UnRead = False
Cells(2, 1).Offset(i, 1).Value = objitem.Subject

120HYH

2003为什么不行啊？用户定义类型未定义
，请楼主解答下，谢。