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

Discussion in 'Microsoft Outlook VBA Programming' started by Janina, Dec 8, 2005.

  1. Janina

    Janina Guest

    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
     
    Janina, Dec 8, 2005
    #1
    1. Advertisements

  2. Try to use "for each" loop instead.

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

    "Janina" <> wrote in message
    news:...
    > 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
    >
     
    Dmitry Streblechenko, Dec 8, 2005
    #2

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Jake Cole

    Looping through items in Inbox and moving them

    Jake Cole, Aug 20, 2004, in forum: Microsoft Outlook VBA Programming
    Replies:
    1
    Views:
    877
    Dmitry Streblechenko \(MVP\)
    Aug 20, 2004
  2. Jack

    Sent redemption message not added to Sent Items folder

    Jack, Apr 21, 2005, in forum: Microsoft Outlook VBA Programming
    Replies:
    3
    Views:
    966
    Guest
    Apr 22, 2005
  3. Guest

    Problem with Sent Items/Redemption

    Guest, Jan 10, 2006, in forum: Microsoft Outlook VBA Programming
    Replies:
    10
    Views:
    1,541
    Guest
    Jan 12, 2006
  4. Dmitry Streblechenko

    Re: Redemption Inbox problem + instability

    Dmitry Streblechenko, Dec 5, 2006, in forum: Microsoft Outlook VBA Programming
    Replies:
    4
    Views:
    687
    Dmitry Streblechenko
    Dec 8, 2006
  5. Aaron

    Trying to Use Redemption to copy msg attachments to inbox

    Aaron, Feb 9, 2009, in forum: Microsoft Outlook VBA Programming
    Replies:
    1
    Views:
    718
    Dmitry Streblechenko
    Feb 9, 2009
Loading...

Share This Page