Reading Email Content Into Access - Catch Duplicate Details

[Graham_T]

Hi,

I am attempting to modify some code that is used for reading content in an Outlook mail and need to catch and move the email if certain content is duplicated in the email.

The code reads the email that is in the following format (see image)

As seen, this email contains 2 devices, but the Serial No in both is duplicated.

In the code, I need to capture this and rather than reading the contents, I need to just move this email to a separate "Manual" folder to be dealt with separately, so not to write the information to the database.

The current code is as follows:

Option Explicit
Private ns As Outlook.Namespace

Private sEmailAddress As String
Private sPerson As String
Private dReceived As Date
Private sComments As String
Private sSerialNo As String
Private sItemNo As String
Private oConnection As Object

Private sItem As String
Private M1 As String
Private M2 As String
Private M3 As String
Private M4 As String
Private M5 As String
Private M6 As String


Sub ReadE3(ByVal mailItem As Object)
Dim lCount As Long
Dim SQL As String
Dim sDate As String

On Error GoTo Manual
sComments = removeTab(ParseText(mailItem.Body, "please put an X here:"))
'Debug.Print "sComments= " & sComments

If sComments <> vbNullString Then
'Call MoveToManual(mailItem)
'Debug.Print "I have fired", sComments
GoTo Manual
End If

Call openConnection

sPerson = mailItem.SenderName
sEmailAddress = mailItem.SenderEmailAddress
dReceived = mailItem.ReceivedTime

For lCount = 1 To 9
M1 = 0
M2 = 0
M3 = 0
M4 = 0
M5 = 0
M6 = 0

sSerialNo = Trim(ParseText(mailItem.Body, "Serial No " & lCount & ":"))
'Debug.Print sSerialNo, Len(sSerialNo)

If Len(sSerialNo) < 3 Then
'Debug.Print "No more"
GoTo Exit_Loop
End If


'// I guess the code needs to do something like this when I count a duplicate serial number in the email??

'If sSerialNo.Count > 1 Then
'Debug.Print "Duplicate Serial, probably split contract, moving to manual"
''Call MoveToManual(mailItem)
'GoTo Manual
'End If

sItemNo = ParseText(mailItem.Body, "Item No " & lCount & ":")

If removeTab(ParseText(mailItem.Body, "Device " & lCount & " M1:")) = vbNullString Or IsNull(removeTab(ParseText(mailItem.Body, "Device " & lCount & " M1:"))) = True Then
M1 = 0
Else
M1 = removeTab(ParseText(mailItem.Body, "Device " & lCount & " M1:"))
End If

If removeTab(ParseText(mailItem.Body, "Device " & lCount & " M2:")) = vbNullString Or IsNull(removeTab(ParseText(mailItem.Body, "Device " & lCount & " M2:"))) = True Then
M2 = 0
Else
M2 = removeTab(ParseText(mailItem.Body, "Device " & lCount & " M2:"))
End If

If removeTab(ParseText(mailItem.Body, "Device " & lCount & " M3:")) = vbNullString Or IsNull(removeTab(ParseText(mailItem.Body, "Device " & lCount & " M3:"))) = True Then
M3 = 0
Else
M3 = removeTab(ParseText(mailItem.Body, "Device " & lCount & " M3:"))
End If

If removeTab(ParseText(mailItem.Body, "Device " & lCount & " M4:")) = vbNullString Or IsNull(removeTab(ParseText(mailItem.Body, "Device " & lCount & " M4:"))) = True Then
M4 = 0
Else
M4 = removeTab(ParseText(mailItem.Body, "Device " & lCount & " M4:"))
End If

If removeTab(ParseText(mailItem.Body, "Device " & lCount & " M5:")) = vbNullString Or IsNull(removeTab(ParseText(mailItem.Body, "Device " & lCount & " M5:"))) = True Then
M5 = 0
Else
M5 = removeTab(ParseText(mailItem.Body, "Device " & lCount & " M5:"))
End If

If removeTab(ParseText(mailItem.Body, "Device " & lCount & " M6:")) = vbNullString Or IsNull(removeTab(ParseText(mailItem.Body, "Device " & lCount & " M6:"))) = True Then
M6 = 0
Else
M6 = removeTab(ParseText(mailItem.Body, "Device " & lCount & " M6:"))
End If

sDate = "CONVERT(DATETIME, '" & Format(dReceived, "yyyy-mm-dd") & " 00:00:00', 102))"
Debug.Print "Sum = " & (CLng(M1) + CLng(M2) + CLng(M3) + CLng(M4) + CLng(M5) + CLng(M6))
If (CLng(M1) + CLng(M2) + CLng(M3) + CLng(M4) + CLng(M5) + CLng(M6)) = 0 Then
'Call MoveToManual(mailItem)
GoTo Manual
Else
SQL = "INSERT INTO Automation.E3 " & _
"(ReceivedDt, EmailAddress, [From], SerialNo, ItemNo, M1, M2, M3, M4, M5, M6) " & _
"VALUES ('" & Format(dReceived, "yyyy-mm-dd hh:mm:ss") & "', '" & removeTab(sEmailAddress) & "', '" & sPerson & "', '" & removeTab(sSerialNo) & "', '" & removeTab(sItemNo) & "', " & M1 & ", " & M2 & ", " & M3 & ", " & M4 & ", " & M5 & ", " & M6 & " )"
End If

'Debug.Print SQL
'Stop
oConnection.Execute SQL

Next lCount

Call closeConnection

Exit_Loop:
Debug.Print "Moving to Imported"
'//commented out GJT 02/07/2013
'Call MoveToImported(mailItem)

Exit_Sub:
Exit Sub

Manual:
'Call MoveToManual(mailItem)
Debug.Print "Doing Nothing"

'GoTo Exit_Sub
End Sub



Thanks in advance for any help provided.

GT