循环浏览Outlook 2010中不是默认收件箱的特定文件夹或收件箱的子文件夹的VBA代码是什么?
Dim ns As Outlook.NameSpace
Dim folder As MAPIFolder
Set ns = Session.Application.GetNamespace("MAPI")
Set folder = Please help me :-)
感谢您的任何提示和帮助,问候Ionic
答案 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}}
比你帮助的人多了!