Option Explicit
'© 2006
Alla rättigheter XL-Dennis
Sub
Retrieve_Info_About_Emails()
Dim
wbBook
As
Workbook
Dim
wsSheet
As
Worksheet
Dim
lnNextRow
As Long
Dim
noSession
As Object
Dim
noDatabase
As Object
Dim
noView
As Object
Dim
noDocument
As Object
Dim
noNextDocument
As Object
Set
wbBook = ThisWorkbook
Set
wsSheet = wbBook.Worksheets(1)
'Tilldela den första raden i arbetsbladet rubriker.
With
wsSheet.Range("A1:F1")
.Value = VBA.Array("Ämne",
"Från",
"Till",
"Kopia",
"Inbäddad",
"Innehåll")
.Font.Bold =
True
End With
'Instansiera Notes session.
Set
noSession =
CreateObject("Notes.NotesSession")
'Instansiera den berörda e-postdatabasen.
'(Här används en lokal e-postdatabas varför
ingen referens anges till en server.)
Set
noDatabase = noSession.GETDATABASE("",
"mail\xldennis.nsf")
'Mappar i Lotus Notes benämns som vyer och här
används Inbox.
Set
noView = noDatabase.GetView("($Inbox)")
'Hämta det första e-post i den definierade
vyn.
Set
noDocument = noView.GetFirstDocument
'Startrad.
lnNextRow =
2
Application.ScreenUpdating =
False
'Loopa igenom alla e-post i vyn InBox.
Do Until
noDocument
Is Nothing
'Fastän den följande ansatsen inte är nödvändig i detta exempel är det en
generell
'ansats som rekommenderas.
Set
noNextDocument = noView.GetNextDocument(noDocument)
'Alla egenskaper är matriser och därför är nödvändigt att explicit ange
vilket objekt
'som ska hämtas från respektive matris.
With
wsSheet
.Cells(lnNextRow,
1).Value
= noDocument.GetItemValue("Subject")(0)
.Cells(lnNextRow,
2).Value
= noDocument.GetItemValue("From")(0)
.Cells(lnNextRow,
3).Value
= noDocument.GetItemValue("SendTo")(0)
.Cells(lnNextRow,
4).Value
= noDocument.GetItemValue("CopyTo")(0)
.Cells(lnNextRow,
5).Value
= noDocument.HasEmbedded
'.Cells(lnNextRow, 6).Value = noDocument.GetItemValue("Body")(0)
End With
Set
noDocument = noNextDocument
lnNextRow = lnNextRow +
1
Loop
wsSheet.Columns("A:F").EntireColumn.AutoFit
'Ta bort objekt fråm minnet.
Set
noNextDocument =
Nothing
Set
noDocument =
Nothing
Set
noView =
Nothing
Set
noDatabase =
Nothing
Set
noSession =
Nothing
Application.ScreenUpdating =
True
End Sub