Redemption Data Object - How do you get a static list of message items in the Inbox for looping?


J

Janina

Hello,

I am using Redemption Data Objects to read messages in the Inbox
folder. This is being run as a Windows scheduled script so I do not
want the process to run indefinitely. The problem I am having is I
can't seem to take a snapshot of the email messages in the Inbox when
the script first starts. I need to loop through each message, save to
a SQL database, then delete the message from the Inbox. My index
becomes incorrect if a "New" message is sent to the Inbox during
processing and some messages get skipped over. Is there any way around
this? My index remains correct when I delete a message since I start
with the last message first (nEmailCount).

Here is my code below:

' Create RDO Session
Set Session = CreateObject("Redemption.RDOSession")
'Session.Logon 'logs on to default Outlook Profile if Profile Name is
not specified
Set Application = CreateObject("Outlook.Application")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT

' Open default Inbox folder
olFolderInbox = 6
Set Inbox = Session.GetDefaultFolder(olFolderInbox)
Set oItems = Inbox.Items

' Count email messages in folder
nEmailCount = oItems.Count
f_log "Total Email Count [" & nEmailCount & "]"
If nEmailCount = -1 Then
objShell.LogEvent information, "Error with Inbox.Items.Count
method"
f_error "Error with Inbox.Items.Count method"
End If

' Process each message in the Inbox
For i = nEmailCount To 1 Step -1
f_log "Processing Email # [" & i & "]"
Set oMsg = oItems.Item(i)
f_log "Contents of oMsg [" & oMsg & "]"

If IsNull(oMsg) Or IsEmpty(oMsg) Then
objShell.LogEvent information, "Error with Retrieve method"
f_log "Error with Retrieve method"
Exit For
End If

' Subject
sSubject = oMsg.Subject
f_log "Subject [" & sSubject & "]"

' From
sFrom = oMsg.SenderName

' Message ID
messageID = oMsg.EntryId
f_log "Message ID [" & messageID & "]"

' Retrieve To and CC Recipients
Set oRecipients = oMsg.Recipients
nRecipientCount = oRecipients.Count
f_log "Total Recipient Count [" & nRecipientCount & "]"

sTo = ""
sCC = ""
For j = 1 To nRecipientCount
Set oRecipient = oRecipients.Item(j)

' Check Recipient Type
If oRecipient.Type = 1 Then ' To
nToCount = nToCount + 1
If j = 1 Then
contactId = ""
leadId = ""
contactId = contactLookupXML(oRecipient.Address)
If contactId = "" Then contactId = "0000000000000000"
leadId = leadLookupXML(oRecipient.Address)
If leadId = "" Then leadId = "0000000000000000"
End If
If InStr(1, sTo, oRecipient.Address) > 0 Then
' do not add
Else
' add recipient
If Len(sTo) = 0 Then
sTo = oRecipient.Address
Else
sTo = sTo & "; " & oRecipient.Address
End If
End If
ElseIf oRecipient.Type = 2 Then ' CC
nCCCount = nCCCount + 1
If InStr(1, sCC, oRecipient.Address) > 0 Then
' do not add
Else
' add recipient
If Len(sCC) = 0 Then
sCC = oRecipient.Address
Else
sCC = sCC & "; " & oRecipient.Address
End If
End If
Else 'BCC
' do nothing
End If
Next

If sTo = "" Then
f_log "No TO found in this email!" & sSubject
End If
f_log "To Count [" & nToCount & "] To [" & sTo & "]"
f_log "CC Count [" & nCCCount & "] CC [" & sCC & "]"

f_log "BodyFormat [" & oMsg.BodyFormat & "]"
Select Case oMsg.BodyFormat
Case 0:
' unspecified
sBody = Trim(oMsg.Body) '?
Case 1:
' plain text
sBody = Trim(oMsg.Body)
Case 2:
' html
sBody = Trim(oMsg.HTMLBody)
Case 3:
' rich text
sBody = Trim(oMsg.RTFBody)
End Select

If contactId <> "0000000000000000" Or leadId <> "0000000000000000"
Then
' Save the email message to the file system
sFilePath = "C:\msg\"
sFileName = messageID & ".msg"
oMsg.SaveAs sFilePath & sFileName

If createActivity = 1 And createInteraction(sFrom, sTo, sCC,
sSubject, sBody, contactId, messageID) = 1 Then
' Delete from Inbox
oMsg.Delete
End If
Else
f_log "Skipping this email."
End If
Next
f_log "END [" & Date & " " & Time & "]"

Thanks,
Janina
 
Ad

Advertisements

D

Dmitry Streblechenko

Try to use "for each" loop instead.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Janina said:
Hello,

I am using Redemption Data Objects to read messages in the Inbox
folder. This is being run as a Windows scheduled script so I do not
want the process to run indefinitely. The problem I am having is I
can't seem to take a snapshot of the email messages in the Inbox when
the script first starts. I need to loop through each message, save to
a SQL database, then delete the message from the Inbox. My index
becomes incorrect if a "New" message is sent to the Inbox during
processing and some messages get skipped over. Is there any way around
this? My index remains correct when I delete a message since I start
with the last message first (nEmailCount).

Here is my code below:

' Create RDO Session
Set Session = CreateObject("Redemption.RDOSession")
'Session.Logon 'logs on to default Outlook Profile if Profile Name is
not specified
Set Application = CreateObject("Outlook.Application")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT

' Open default Inbox folder
olFolderInbox = 6
Set Inbox = Session.GetDefaultFolder(olFolderInbox)
Set oItems = Inbox.Items

' Count email messages in folder
nEmailCount = oItems.Count
f_log "Total Email Count [" & nEmailCount & "]"
If nEmailCount = -1 Then
objShell.LogEvent information, "Error with Inbox.Items.Count
method"
f_error "Error with Inbox.Items.Count method"
End If

' Process each message in the Inbox
For i = nEmailCount To 1 Step -1
f_log "Processing Email # [" & i & "]"
Set oMsg = oItems.Item(i)
f_log "Contents of oMsg [" & oMsg & "]"

If IsNull(oMsg) Or IsEmpty(oMsg) Then
objShell.LogEvent information, "Error with Retrieve method"
f_log "Error with Retrieve method"
Exit For
End If

' Subject
sSubject = oMsg.Subject
f_log "Subject [" & sSubject & "]"

' From
sFrom = oMsg.SenderName

' Message ID
messageID = oMsg.EntryId
f_log "Message ID [" & messageID & "]"

' Retrieve To and CC Recipients
Set oRecipients = oMsg.Recipients
nRecipientCount = oRecipients.Count
f_log "Total Recipient Count [" & nRecipientCount & "]"

sTo = ""
sCC = ""
For j = 1 To nRecipientCount
Set oRecipient = oRecipients.Item(j)

' Check Recipient Type
If oRecipient.Type = 1 Then ' To
nToCount = nToCount + 1
If j = 1 Then
contactId = ""
leadId = ""
contactId = contactLookupXML(oRecipient.Address)
If contactId = "" Then contactId = "0000000000000000"
leadId = leadLookupXML(oRecipient.Address)
If leadId = "" Then leadId = "0000000000000000"
End If
If InStr(1, sTo, oRecipient.Address) > 0 Then
' do not add
Else
' add recipient
If Len(sTo) = 0 Then
sTo = oRecipient.Address
Else
sTo = sTo & "; " & oRecipient.Address
End If
End If
ElseIf oRecipient.Type = 2 Then ' CC
nCCCount = nCCCount + 1
If InStr(1, sCC, oRecipient.Address) > 0 Then
' do not add
Else
' add recipient
If Len(sCC) = 0 Then
sCC = oRecipient.Address
Else
sCC = sCC & "; " & oRecipient.Address
End If
End If
Else 'BCC
' do nothing
End If
Next

If sTo = "" Then
f_log "No TO found in this email!" & sSubject
End If
f_log "To Count [" & nToCount & "] To [" & sTo & "]"
f_log "CC Count [" & nCCCount & "] CC [" & sCC & "]"

f_log "BodyFormat [" & oMsg.BodyFormat & "]"
Select Case oMsg.BodyFormat
Case 0:
' unspecified
sBody = Trim(oMsg.Body) '?
Case 1:
' plain text
sBody = Trim(oMsg.Body)
Case 2:
' html
sBody = Trim(oMsg.HTMLBody)
Case 3:
' rich text
sBody = Trim(oMsg.RTFBody)
End Select

If contactId <> "0000000000000000" Or leadId <> "0000000000000000"
Then
' Save the email message to the file system
sFilePath = "C:\msg\"
sFileName = messageID & ".msg"
oMsg.SaveAs sFilePath & sFileName

If createActivity = 1 And createInteraction(sFrom, sTo, sCC,
sSubject, sBody, contactId, messageID) = 1 Then
' Delete from Inbox
oMsg.Delete
End If
Else
f_log "Skipping this email."
End If
Next
f_log "END [" & Date & " " & Time & "]"

Thanks,
Janina
 

Top