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
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