Thread: EntryID problem
View Single Post
  #1  
Old August 22nd 07, 01:01 PM posted to microsoft.public.outlook.program_vba
vonClausowitz
external usenet poster
 
Posts: 29
Default EntryID problem

Hi All,

I'm trying to compare emails in two different mailboxes. Therefor I
need the SMTP address, the only way to do that is via the EntryID.
When using my code and can't seem to get into the second mailbox. I
get an MAPI_E_LOGON failure message.

Private Sub cmdInlezen2_Click()

Dim oudDatum As Date 'datum laatst gecheckte email
Dim nieuwDatum As Date 'datum oudste email in eigen folder
Dim iNumItems, iNumOwnItems As Integer
Dim iTotal As Integer
Dim i As Integer

Dim objSession As MAPI.Session
Dim objMsg As MAPI.Message
Dim objsender As MAPI.AddressEntry
Dim objItem As outlook.MailItem

Set objSession = CreateObject("MAPI.session")
objSession.Logon "", "", False, False

iNumItems = olDeleteFolder.Items.Count
iNumOwnItems = olOwnFolder.Items.Count
iTotal = iNumItems + iNumOwnItems

'bepaal de jongste en oudste email in mijn eigen folder
oudDatum = olOwnFolder.Items.Item(iNumOwnItems).ReceivedTime 'de
oudste email
nieuwDatum = olOwnFolder.Items.Item(1).ReceivedTime 'de laatst
binnengekomen email

'eigen Inbox inlezen in Listview1
For Each olmailitem In olOwnFolder.Items
If olmailitem.Class = olMail Then 'alleen echte emails
vergelijken
If olmailitem.Subject = "" Then
GoTo NoSubject
End If
Set objMsg = objSession2.GetMessage(objItem.EntryID)
Set objsender = objMsg.Sender
Set itmX = ListView1.ListItems.Add(, ,
objsender.Address, , 2)
itmX.SubItems(1) = olmailitem.Subject
itmX.SubItems(2) = olmailitem.ReceivedTime
End If
NoSubject:
Next

'Deleted Items CLASSINT inlezen in Listview2
For Each objItem In olDeleteFolder.Items
If objItem.Class = olMail Then 'alleen echte emails vergelijken
If objItem.ReceivedTime = oudDatum Then 'alleen emails die
jonger of even oud zijn
If objItem.Subject = "" Then
GoTo NoSubject2
End If
Set objMsg = objSession2.GetMessage(objItem.EntryID)
Set objsender = objMsg.Sender
Set itmX = ListView2.ListItems.Add(, ,
objsender.Address, , 2)
itmX.SubItems(1) = objItem.Subject
itmX.SubItems(2) = objItem.ReceivedTime
End If
If DateDiff("n", objItem.ReceivedTime, oudDatum) 60 Then
'er moet minimaal 60 minuten tussen zitten
'If objItem.ReceivedTime oudDatum Then 'stoppen er zijn
geen emails meer
Exit For
End If
End If
NoSubject2:
Next

End Sub

Regards
Marco

Ads