如何遍历outlook中的特定文件夹

时间:2015-10-07 13:46:29

标签: vba outlook outlook-vba

循环浏览Outlook 2010中不是默认收件箱的特定文件夹或收件箱的子文件夹的VBA代码是什么?

    Dim ns As Outlook.NameSpace
    Dim folder As MAPIFolder

    Set ns = Session.Application.GetNamespace("MAPI")
    Set folder = Please help me :-)

感谢您的任何提示和帮助,问候Ionic

2 个答案:

答案 0 :(得分:0)

更改

Set ns = Session.Application.GetNamespace("MAPI")

Set ns = Session.Application.GetNamespace("MAPI").PickFolder

这将提示您选择文件夹。

这是我前段时间写的一个完整例程,可能会有所帮助,请记住这是为了可以从Excel运行但是应该为您提供所需的语法:

Sub GetMail()

     '// This sub is designed to be used with a blank worksheet. It will create the header 
     '// fields as required, and continue to populate the email data below the relevant header. 

     '// Declare required variables 
     '------------------------------------------------------------- 
    Dim olApp As Object
    Dim olFolder As Object
    Dim olMailItem As Object

    Dim strTo As String
    Dim strFrom As String
    Dim dateSent As Variant
    Dim dateReceived As Variant
    Dim strSubject As String
    Dim strBody As String

    Dim loopControl As Variant
    Dim mailCount As Long
    Dim totalItems As Long
     '------------------------------------------------------------- 

     '//Turn off screen updating 
    Application.ScreenUpdating = False

     '//Setup headers for information 
    Range("A1:F1").Value = Array("To", "From", "Subject", "Body", "Sent (from Sender)", "Received (by Recipient)")

     '//Format columns E and F to 
    Columns("E:F").EntireColumn.NumberFormat = "DD/MM/YYYY HH:MM:SS"

     '//Create instance of Outlook 
    Set olApp = CreateObject("Outlook.Application")

     '//Select folder to extract mail from 
    Set olFolder = olApp.GetNamespace("MAPI").PickFolder

     '//Get count of mail items 
    totalItems = olFolder.items.Count
    mailCount = 0

     '//Loop through mail items in folder 
    For Each loopControl In olFolder.items

         '//If loopControl is a mail item then continue 
        If TypeName(loopControl) = "MailItem" Then

             '//Increase mailCount 
            mailCount = mailCount + 1

             '//Inform user of item count in status bar 
            Application.StatusBar = "Reading email no. " & mailCount & " of " & totalItems

             '//Get mail item 
            Set olMailItem = loopControl

             '//Get Details 
            With olMailItem
                strTo = .To
                 '//If strTo begins with "=" then place an apostrophe in front to denote text format 
                If Left(strTo, 1) = "=" Then strTo = "'" & strTo 
                strFrom = .Sender
                 '//If sender displays name only, show name followed by email address e.g.(Bloggs, Joe < j.bloggs@mail.com >) 
                If InStr(1, strFrom, "@") < 1 Then strFrom = strFrom & " - < " & .SenderEmailAddress & " >"
                dateSent = .SentOn
                dateReceived = .ReceivedTime
                strSubject = .Subject
                strBody = .Body
            End With

             '//Place information into spreadsheet 
             '//import information starting from last blank row in column A 
            With Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                .Value = strTo
                .Offset(0, 1).Value = strFrom
                .Offset(0, 2).Value = strSubject

                 '//Check for previous replies by looking for "From:" in the body text 
                 '//Check for the word "From:" 
                If InStr(0, strBody, "From:") > 0 Then
                     '//If exists, copy start of email body, up to the position of "From:" 
                    .Offset(0, 3).Value = Mid(strBody, 1, InStr(1, strBody, "From:") - 1)
                Else
                     '//If doesn't exist, copy entire mail body 
                    .Offset(0, 3).Value = strBody
                End If

                .Offset(0, 4).Value = dateSent
                .Offset(0, 5).Value = dateReceived

            End With

             '//Release item from memory 
            Set olMailItem = Nothing

        End If

         '//Next Item 
    Next loopControl

     '//Release items from memory 
    Set olFolder = Nothing
    Set olApp = Nothing

     '//Resume screen updating 
    Application.ScreenUpdating = True

     '//reset status bar 
    Application.StatusBar = False

     '//Inform user that code has finished 
    MsgBox mailCount & " messages copied successfully.", vbInformation, "Complete"

End Sub

答案 1 :(得分:0)

好的,我自己也找到了。

{{1}}

比你帮助的人多了!