updating mileage field of email ite (1 Viewer)

groengoen · Oct 7, 2010

I am trying to save emails to an access database. I advice has been given as follows in the forum (I would suggest that you then get the ID number of this DB record and add this ID to the "mileage" field of the email item. Then you will always be able to find this email in outlook again (unless it is deleted) ), and have decided that this is the way to go but can't figure out how you put the ID into the mileage field. This is the code i tried (modified copy of code available online):

Code:

'This function will scan your inbox and return a mailitem that has a subject that matches subject line
Private Function ScanInbox(SubjectLine As String)
    Dim strSQL As String
    Dim sentTime As Date
    Dim sentDate As Date
    Dim sentDateTime As Date
    Dim tempDate As Date
    Dim tmp1Date As Date
    Dim tmp1Time As Date
    Dim tempTime As Date
    Dim sentId As String
    Dim tempId As Integer
    Dim chkDate As Date
    Dim TempRst As dao.Recordset
    Dim OlApp As Outlook.Application
    Dim Inbox As Outlook.MAPIFolder
    Dim InboxItems As Outlook.Items
    Dim Mailobject As Object
    Set OlApp = CreateObject("Outlook.Application")
    Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
    Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp", dbOpenDynaset)
    If SubjectLine <> "" Then
        Set InboxItems = Inbox.Items.Restrict("[Subject] = """ & SubjectLine & """")
    Else
        Set InboxItems = Inbox.Items
    End If
    
    For Each Mailobject In InboxItems
    'check that it is in fact an email that has been chosen
        If Mailobject.Class = olMail Then
            'Process as it is an email

            sentDateTime = Mailobject.SentOn
            sentId = Mailobject.Mileage
            sentDate = FormatDateTime(Mailobject.SentOn, vbShortDate)
            sentTime = FormatDateTime(Mailobject.SentOn, vbLongTime)
            If TempRst.RecordCount <> 0 Then
' Date/Time checks removed. Trying Id match instead (based on MailObject.Mileage)
'                strSQL = "[DateSent] =  #" & sentDateTime & "#"
                strSQL = "[Id] = " & sentId
                TempRst.FindFirst strSQL & "9"
' Date/Time checks removed. Trying Id match instead (based on MailObject.Mileage)
'                tmp1Date = [DateSent]
'                tempTime = FormatDateTime(tmp1Date, vbLongTime)
'                tempId = TempRst("Id")
                'If Times don't match then store email
                If TempRst.NoMatch Or sentId = "" Then
                    With TempRst
                        On Error Resume Next
                        .AddNew
                        !Subject = Mailobject.Subject
                        !From = Mailobject.SenderName
                        !To = Mailobject.To
                        !BOdy = Mailobject.BOdy
                        !DateSent = Mailobject.SentOn
                        .Update
                        Mailobject.Mileage = TempRst("Id")
                        'Mailobject.Read = True
                    End With
                End If
            Else
                With TempRst
                    On Error Resume Next
                    .AddNew
                    !Subject = Mailobject.Subject
                    !From = Mailobject.SenderName
                    !To = Mailobject.To
                    !BOdy = Mailobject.BOdy
                    !DateSent = Mailobject.SentOn
                    .Update
                    Mailobject.Mileage = TempRst("Id")
                    'Mailobject.Read = True
                End With
            End If
            
        End If
    Next
    
    Set OlApp = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
    Set TempRst = Nothing
End Function

darbid · Oct 7, 2010

The code you show is getting a collection of mail objects and reading each mail item.
This line reads the property Mileage and puts it into the variable sentId

Code:

sentId = Mailobject.Mileage

Unless you have other code elsewhere which has added the ID to Mileage then this property will be empty. If you are looking for the ID of a mailitem in outlook then use .ID. But you must know that if you move a mail item to anther folder the ID will change. Thus the advice of using Mileage

groengoen · Oct 8, 2010

The code you quote is just seeing whether there is a pre-existing value, implying that that item had already been included in the temporary table.

Further on in the code it has the line:

Code:

                        Mailobject.Mileage = TempRst("Id")

This is where I am trying to update the mileage. The field TempRst("Id") has a value at this stage, unfortunately it seems to be the same value each time.

I run the code through twice.
The first time fills the temporary table. The 2nd run is to check whether it will pull in duplicates, which it does, and I was hoping to prevent.

When I look at the mileage on the email items that I am importing a 2nd time it still seems to be empty, implying that my update didn't work.

I am trying to find out what I am doing wrong.

groengoen · Oct 8, 2010

It is possible that I am using the wrong field type for sentid which I have as String.

groengoen · Oct 8, 2010

also the code

Code:

TempRst.FindFirst strSQL & "9"

is wrong

it should be

Code:

TempRst.FindFirst strSQL

sorry! I introduced that because on the 2nd run sentid was "" but I was getting an error on the FindFirst which showed the strSQL to be "[Id] = " without anything on the right of the = sign. I didn't get this on the first run. Evidently the type coming from

Code:

Mailobject.Mileage

was different to what went in from

Code:

sentId

darbid · Oct 9, 2010

I would suggest you put a break at the beginning and F8 through this.

1. Check the exact Email Object found (so that you can later check that email in outlook)
2. Check that your table "ID" actually has a value
3. add something straight after adding an id to mileage like debug.print Mailobject.Mileage (which will tell you if it was added or not)

groengoen · Nov 19, 2010

Hi Darbid,
I eventually got around to testing this again after amending some errors in the code. I went thru the 3 points as suggested. My table has an "ID", the debug.print shows 4 values going into the 4 records I am testing (my id's are autonumbers and go up by 1). I run the test a 2nd time on the records I just inserted into the table, to see whether I can eliminate putting in the records a 2nd time time as duplicates. In order to eliminate them I look at the mailobject.mileage field and this shows up as empty. I expect to see the "ID" value I put in on the first run. This is the code I am using now:

Code:

Private Function ScanInbox(SubjectLine As String)
'This function will scan your inbox and return a mailitem that has a subject that matches subject line
    Dim strSQL As String
    Dim sentTime As Date
    Dim sentDate As Date
    Dim sentDateTime As Date
    Dim tempDate As Date
    Dim tmp1Date As Date
    Dim tmp1Time As Date
    Dim tempTime As Date
    Dim sentId As String
    Dim tempId As Integer
    Dim chkDate As Date
    Dim TempRst As DAO.Recordset
    Dim OlApp As Outlook.Application
    Dim Inbox As Outlook.MAPIFolder
    Dim InboxItems As Outlook.Items
    Dim Mailobject As Object
    Dim blEmptyTable As Boolean
    
    blEmptyTable = False
    
    Set OlApp = CreateObject("Outlook.Application")
    Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
    Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp", dbOpenDynaset)
    If SubjectLine <> "" Then
        Set InboxItems = Inbox.Items.Restrict("[Subject] = """ & SubjectLine & """")
    Else
        Set InboxItems = Inbox.Items
    End If
    
    For Each Mailobject In InboxItems
    'check that it is in fact an email that has been chosen
        If Mailobject.Class = olMail Then
            'Process as it is an email
                        
            If TempRst.RecordCount <> 0 Then
            'There are records
                If blEmptyTable Then
                'The table was originally empty. No need to check for duplicates
                    With TempRst
                        On Error Resume Next
                        .AddNew
                        !Subject = Mailobject.Subject
                        !From = Mailobject.SenderName
                        !To = Mailobject.To
                        !Contents = Mailobject.BOdy
                        !Created = Mailobject.SentOn
                        Mailobject.Mileage = TempRst("Id")
                        .Update
                        Debug.Print Mailobject.Mileage
                        'Mailobject.Read = True
                    End With
                Else
                'The table already has records. Check for duplicates
'                    sentDateTime = Mailobject.SentOn
'                    sentDate = FormatDateTime(Mailobject.SentOn, vbShortDate)
'                    sentTime = FormatDateTime(Mailobject.SentOn, vbLongTime)
                    Debug.Print Mailobject.Mileage
                    sentId = Mailobject.Mileage
                    strSQL = "[Id] = " & Val(sentId)
                    TempRst.FindFirst strSQL
                    If TempRst.NoMatch Or sentId = "" Then
                    'There is no duplicate
                        With TempRst
                            On Error Resume Next
                            .AddNew
                            !Subject = Mailobject.Subject
                            !From = Mailobject.SenderName
                            !To = Mailobject.To
                            !Contents = Mailobject.BOdy
                            !Created = Mailobject.SentOn
                            Mailobject.Mileage = TempRst("Id")
                            .Update
                            Debug.Print Mailobject.Mileage
                            'Mailobject.Read = True
                        End With
                    End If
                End If
                
            Else
            'The table is empty. Don't check for duplicates
                blEmptyTable = True
                With TempRst
                    On Error Resume Next
                    .AddNew
                    !Subject = Mailobject.Subject
                    !From = Mailobject.SenderName
                    !To = Mailobject.To
                    !Contents = Mailobject.BOdy
                    !Created = Mailobject.SentOn
                    Mailobject.Mileage = TempRst("Id")
                    .Update
                    Debug.Print Mailobject.Mileage
                    'Mailobject.Read = True
                End With
            End If
            
        End If
    Next
    
    Set OlApp = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
    Set TempRst = Nothing
End Function

Any help would be greatly appreciated.

Geoff

groengoen · Nov 19, 2010

I have attached a zipped copy of the mdb

groengoen · Nov 20, 2010

I actually decided that I was having too much hassle with the mileage field so went with checking the date and time created, and that worked successfully.

updating mileage field of email ite (1 Viewer)

groengoen

Registered User.

darbid

Registered User.

groengoen

Registered User.

groengoen

Registered User.

groengoen

Registered User.

darbid

Registered User.

groengoen

Registered User.

groengoen

Registered User.

Attachments

groengoen

Registered User.

Similar threads

Users who are viewing this thread