Hi: I have two files. I search pattern ":" from emails text file and
save email contents into a database. Another search pattern "[" from
emails text file and same save it into database. Both database works
the same save emails which are in a text file and put them into
database. My problem is that the one which search ":" pattern has to be
change with search pattern "[" style one. It needs minor changes in
the search ":" pattern file but i dont know where would i do the
changes. Need Help
File Search ":" Pattern (Needs to be change)
--------------------------------
Option Compare Database
Option Explicit
Private Sub Command26_Click()
DoCmd.Close
End Sub
Private Sub cmdParse_Click()
DoCmd.SetWarnings False
Dim strfile As String
Dim AcctNum As String
AcctNum = "Account Number"
'Box
Credits----------------------------------------------------------------------------
'-----------------------------------------------------------------------------------
ChDir ("C:\MailSave\Requests\")
strfile = Dir("C:\MailSave\Requests\200" & "*.*")
Do While Len(strfile) 0
FileCopy "C:\MailSave\Requests\" & strfile,
"C:\MailSave\GetInfo.txt"
Dim fileName As String
Dim stemp, linesfromfile, nextline As String
Dim iFIle As Integer
iFIle = FreeFile
Open "C:\MailSave\Requests\" & strfile For Input As iFIle
While Not EOF(1)
Line Input #1, nextline
linesfromfile = linesfromfile + nextline + Chr(13) + Chr(10)
Wend
Close iFIle
Call TestReplace
Me.txtEmail.Value = linesfromfile
Kill "C:\MailSave\Requests\" & strfile
strfile = Dir("C:\MailSave\Requests\200" & "*.*")
linesfromfile = ""
Dim strEmail As String
Dim bNameFound As Boolean
Dim bAddressFound As Boolean
Dim bCityStateZipFound As Boolean
Dim bSubjectFound As Boolean
Dim bReturnMethodFound As Boolean
Dim bAccountNumFound As Boolean
Dim bReturnDateFound As Boolean
Dim bCommentsFound As Boolean
Dim bBoxTypeFound As Boolean
Dim bBoxQtyFound As Boolean
Dim bCreditAmountFound As Boolean
Dim bConvertersFound As Boolean
Dim bSenderFound As Boolean
Dim bRequestDateFound As Boolean
Dim strStringBefore As String
Dim strName As String
Dim strAddress As String
Dim strCityStateZip As String
Dim strSubject As String
Dim strReturnMethod As String
Dim strAccountNum As String
Dim strCurrentChar As String
Dim strReturnDate As String
Dim strComments As String
Dim strBoxType As String
Dim strBoxQty As String
Dim strCreditAmount As String
Dim strConverterNumbers As String
Dim strSender As String
Dim strRequestDate As String
Dim lngLengthOfEmail As Long
Dim lngCharPointer1 As Long
Dim lngCharPointer2 As Long
Dim dbDatabase As DAO.Database
Dim rsRecordset As DAO.Recordset
If (IsNull(Me.txtEmail.Value)) Then
MsgBox "[email] field is blank. Please try again.",
vbExclamation + vbOKOnly
Me.txtEmail.SetFocus
Exit Sub
End If
Me.txtStatusBar.Value = "Parsing..."
strEmail = Me.txtEmail.Value
' Initialize
bNameFound = False
bAddressFound = False
bCityStateZipFound = False
bSubjectFound = False
bReturnMethodFound = False
bAccountNumFound = False
bCommentsFound = False
bBoxQtyFound = False
bBoxTypeFound = False
bCreditAmountFound = False
bConvertersFound = False
bReturnDateFound = False
bSenderFound = False
bRequestDateFound = False
strRequestDate = ""
strName = ""
strAddress = ""
strCityStateZip = ""
strSubject = ""
strReturnMethod = ""
strAccountNum = ""
strStringBefore = ""
strComments = ""
strBoxQty = ""
strBoxType = ""
strCreditAmount = ""
strConverterNumbers = ""
strReturnDate = ""
strSender = ""
lngLengthOfEmail = Len(strEmail)
lngCharPointer1 = 0
' Search for request date, sender name
Do While (strCurrentChar <")")
'And (Not bCommentsFound))
strCurrentChar = Left(strEmail, 1)
If (strCurrentChar = ":") Then
' Search for keywords in string before ':'
If (InStr(strStringBefore, "Date")) Then
If (Not bRequestDateFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save name until crlf
Do While (strCurrentChar <vbCr)
strRequestDate = strRequestDate & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bRequestDateFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Sender--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "kdb by")) Then
If (Not bSenderFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <")")
strSender = strSender & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bSenderFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
Else
' Reset string before ':' and move to the next character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
Else
' Append this character to string that is before ':'
strStringBefore = strStringBefore & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
' Advance the character pointer
lngCharPointer1 = lngCharPointer1 + 1
Loop
'Get rid of 1st line, has keyword 'name' in name change form
'strCurrentChar = Left(strEmail, 1)
'Do While (strCurrentChar <".")
'Move to the next character
' strEmail = Right(strEmail, (Len(strEmail) - 1))
' strCurrentChar = Left(strEmail, 1)
' lngCharPointer1 = lngCharPointer1 + 1
'Loop
'Move to the next character=
Do While ((lngCharPointer1 <= lngLengthOfEmail))
'And (Not bCommentsFound))
strCurrentChar = Left(strEmail, 1)
If (strCurrentChar = ":") Then
' Search for keywords in string before ':'
'Name--------------------------------------------------------------
If (InStr(strStringBefore, "Name")) Then
If (Not bNameFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save name until crlf
Do While (strCurrentChar <vbCr)
strName = strName & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bNameFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Subject--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Subject")) Then
If (Not bSubjectFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strSubject = strSubject & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bSubjectFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Return
Method--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Return Method")) Then
If (Not bReturnMethodFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strReturnMethod = strReturnMethod & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bReturnMethodFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Return
Date--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Date of Return")) Then
If (Not bReturnDateFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strReturnDate = strReturnDate & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bReturnDateFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Account
Number-------------------------------------------------------
ElseIf (InStr(strStringBefore, AcctNum)) Then
If (Not bAccountNumFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strAccountNum = strAccountNum & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bAccountNumFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'BoxType--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Type Of Box")) Then
If (Not bBoxTypeFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strBoxType = strBoxType & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bBoxTypeFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'BoxQty--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "How Many Boxes")) Then
If (Not bBoxQtyFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strBoxQty = strBoxQty & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bBoxQtyFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'CreditAmount--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Amount To Credit")) Then
If (Not bCreditAmountFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strCreditAmount = strCreditAmount & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bCreditAmountFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'ConverterNumbers--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "ConverterNumbers")) Then
If (Not bConvertersFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strConverterNumbers = strConverterNumbers &
strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bConvertersFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Comments--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Comments")) Then
If (Not bCommentsFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strComments = strComments & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bCommentsFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Address--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Address")) Then
If (Not bAddressFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strAddress = strAddress & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bAddressFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'CityStateZip--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Zip")) Then
If (Not bCityStateZipFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save city, state, zip until cr
Do While ((strCurrentChar <vbCr) And (Not
(lngCharPointer1 lngLengthOfEmail)))
strCityStateZip = strCityStateZip & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bCityStateZipFound = True
End If
Else
' Reset string before ':' and move to the next character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
Else
' Append this character to string that is before ':'
strStringBefore = strStringBefore & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
' Advance the character pointer
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Clear white space, from right
If (bNameFound) Then
strCurrentChar = Right(strName, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strName = Left(strName, (Len(strName) - 1))
strCurrentChar = Right(strName, 1)
Loop
End If
If (bSenderFound) Then
strCurrentChar = Right(strSender, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strSender = Left(strSender, (Len(strSender) - 1))
strCurrentChar = Right(strSender, 1)
Loop
End If
If (bSubjectFound) Then
strCurrentChar = Right(strSubject, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strSubject = Left(strSubject, (Len(strSubject) - 1))
strCurrentChar = Right(strSubject, 1)
Loop
End If
If (bReturnMethodFound) Then
strCurrentChar = Right(strReturnMethod, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strReturnMethod = Left(strReturnMethod, (Len(strReturnMethod) -
1))
strCurrentChar = Right(strReturnMethod, 1)
Loop
End If
If (bAccountNumFound) Then
strCurrentChar = Right(strAccountNum, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strAccountNum = Left(strAccountNum, (Len(strAccountNum) - 1))
strCurrentChar = Right(strAccountNum, 1)
Loop
End If
If (bAddressFound) Then
strCurrentChar = Right(strAddress, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strAddress = Left(strAddress, (Len(strAddress) - 1))
strCurrentChar = Right(strAddress, 1)
Loop
End If
If (bCityStateZipFound) Then
strCurrentChar = Right(strCityStateZip, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strCityStateZip = Left(strCityStateZip, (Len(strCityStateZip) -
1))
strCurrentChar = Right(strCityStateZip, 1)
Loop
End If
If (bReturnDateFound) Then
strCurrentChar = Right(strReturnDate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strReturnDate = Left(strReturnDate, (Len(strReturnDate) - 1))
strCurrentChar = Right(strReturnDate, 1)
Loop
End If
If (bBoxTypeFound) Then
strCurrentChar = Right(strReturnDate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strReturnDate = Left(strReturnDate, (Len(strReturnDate) - 1))
strCurrentChar = Right(strReturnDate, 1)
Loop
End If
If (bBoxQtyFound) Then
strCurrentChar = Right(strReturnDate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strReturnDate = Left(strReturnDate, (Len(strReturnDate) - 1))
strCurrentChar = Right(strReturnDate, 1)
Loop
End If
If (bCreditAmountFound) Then
strCurrentChar = Right(strReturnDate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strReturnDate = Left(strReturnDate, (Len(strReturnDate) - 1))
strCurrentChar = Right(strReturnDate, 1)
Loop
End If
If (bCommentsFound) Then
strCurrentChar = Right(strComments, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strComments = Left(strComments, (Len(strComments) - 1))
strCurrentChar = Right(strComments, 1)
Loop
End If
Me.txtStatusBar.Value = "Parsing...Complete."
'Debug.Print _
' "Name Found: " & bNameFound & vbCrLf & _
' "Name: " & strName & vbCrLf & vbCrLf & _
' "Address Found: " & bAddressFound & vbCrLf & _
' "Address: " & strAddress & vbCrLf & vbCrLf & _
' "City, State, Zip Found: " & bCityStateZipFound & vbCrLf & _
' "City, State, Zip: " & strCityStateZip
If (bNameFound And bAddressFound And bCityStateZipFound And
bSubjectFound And bAccountNumFound) Then
Me.txtStatusBar.Value = "Creating record..."
' Found all the fields
Set dbDatabase = CurrentDb()
Set rsRecordset = dbDatabase.OpenRecordset("tblCustomers")
' Create a new record with parsed info
rsRecordset.AddNew
rsRecordset.Fields(1).Value = UCase(strRequestDate)
rsRecordset.Fields(2).Value = UCase(strName)
rsRecordset.Fields(3).Value = UCase(strSender)
rsRecordset.Fields(4).Value = UCase(strAddress)
rsRecordset.Fields(5).Value = UCase(strCityStateZip)
rsRecordset.Fields(6).Value = UCase(strSubject)
rsRecordset.Fields(7).Value = UCase(strReturnMethod)
rsRecordset.Fields(8).Value = UCase(strAccountNum)
rsRecordset.Fields(9).Value = UCase(strReturnDate)
rsRecordset.Fields(10).Value = UCase(strBoxType)
rsRecordset.Fields(11).Value = UCase(strBoxQty)
rsRecordset.Fields(12).Value = UCase(strCreditAmount)
rsRecordset.Fields(13).Value = UCase(strConverterNumbers)
rsRecordset.Fields(14).Value = UCase(strComments)
rsRecordset.Update
rsRecordset.Close
Set rsRecordset = Nothing
dbDatabase.Close
Set dbDatabase = Nothing
Else
'Could not find all or some of the fields
'Add incomplete record to exceptions table for manual processing.
Set dbDatabase = CurrentDb()
Set rsRecordset = dbDatabase.OpenRecordset("tblExceptions")
rsRecordset.AddNew
rsRecordset.Fields(1).Value = Me.txtEmail.Value
rsRecordset.Fields(2).Value = Now()
rsRecordset.Update
rsRecordset.Close
Set rsRecordset = Nothing
dbDatabase.Close
Set dbDatabase = Nothing
'MsgBox "Could not find a field. Please try again.", vbExclamation
+ vbOKOnly
End If
' Clear email field and get ready for another one
Me.txtEmail.Value = Null
Me.txtEmail.SetFocus
Kill "C:\MailSave\GetInfo.txt"
Loop
DoCmd.SetWarnings False
DoCmd.OpenQuery "qry_LoadWork", acViewNormal, acEdit
DoCmd.OpenQuery "qry_UpdateBCSubject", acViewNormal, acEdit
DoCmd.OpenQuery "qry_UpdateCRSubject", acViewNormal, acEdit
DoCmd.OpenQuery "qry_DeleteParsed", acViewNormal, acEdit
Me.txtStatusBar.Value = "Creating record...Complete."
Exit_cmdParse_Click:
Exit Sub
End Sub
--------------------------------------------------------------------------------------------------
File Search "[" Pattern
--------------------------------
Option Compare Database
Option Explicit
Private Sub Command26_Click()
DoCmd.Close
End Sub
Private Sub cmdParse_Click()
DoCmd.SetWarnings False
Dim strfile As String
Dim AcctNum As String
AcctNum = "Account Number"
ChDir ("C:\MailSave\Requests\")
strfile = Dir("C:\MailSave\Requests\200" & "*.*")
Do While Len(strfile) 0
FileCopy "C:\MailSave\Requests\" & strfile,
"C:\MailSave\GetInfo.txt"
Dim fileName As String
Dim stemp, linesfromfile, nextline As String
Dim iFIle As Integer
iFIle = FreeFile
Open "C:\MailSave\Requests\" & strfile For Input As iFIle
While Not EOF(1)
Line Input #1, nextline
linesfromfile = linesfromfile + nextline + Chr(13) + Chr(10)
Wend
Close iFIle
Call TestReplace
Me.txtEmail.Value = linesfromfile
Kill "C:\MailSave\Requests\" & strfile
strfile = Dir("C:\MailSave\Requests\200" & "*.*")
linesfromfile = ""
Dim strEmail As String
Dim bRequestDateFound As Boolean
Dim bSenderFound As Boolean
Dim bSubjectFound As Boolean
Dim bNameFound As Boolean
Dim bAddressFound As Boolean
Dim bCityStateZipFound As Boolean
Dim bAccountNumFound As Boolean
Dim bInstallDateFound As Boolean
Dim bLastEventDateFound As Boolean
Dim bPPVHoldFound As Boolean
Dim bMonthlyRateFound As Boolean
Dim bServicesFound As Boolean
Dim bRequestTypeFound As Boolean
Dim bLanguageFound As Boolean
Dim bCRCPINFound As Boolean
Dim bEventNumDateRangeFound As Boolean
Dim bSummaryFound As Boolean
Dim bVerifyBoxFound As Boolean
Dim bMDPageIDFound As Boolean
Dim strStringBefore As String
Dim strCurrentChar As String
Dim strRequestDate As String
Dim strSender As String
Dim strSubject As String
Dim strName As String
Dim strAddress As String
Dim strCityStateZip As String
Dim strAccountNum As String
Dim strInstallDate As String
Dim strLastEventDate As String
Dim strPPVHold As String
Dim strMonthlyRate As String
Dim strServices As String
Dim strRequestType As String
Dim strLanguage As String
Dim strCRCPIN As String
Dim strEventNumDateRange As String
Dim strSummary As String
Dim strVerifyBox As String
Dim strMDPageID As String
Dim lngLengthOfEmail As Long
Dim lngCharPointer1 As Long
Dim lngCharPointer2 As Long
Dim dbDatabase As DAO.Database
Dim rsRecordset As DAO.Recordset
If (IsNull(Me.txtEmail.Value)) Then
MsgBox "[email] field is blank. Please try again.",
vbExclamation + vbOKOnly
Me.txtEmail.SetFocus
Exit Sub
End If
Me.txtStatusBar.Value = "Parsing..."
strEmail = Me.txtEmail.Value
'Initialize----------------------------------------------
bRequestDateFound = False
bSenderFound = False
bSubjectFound = False
bNameFound = False
bAddressFound = False
bCityStateZipFound = False
bAccountNumFound = False
bInstallDateFound = False
bLastEventDateFound = False
bPPVHoldFound = False
bMonthlyRateFound = False
bServicesFound = False
bRequestTypeFound = False
bLanguageFound = False
bCRCPINFound = False
bEventNumDateRangeFound = False
bSummaryFound = False
bVerifyBoxFound = False
bMDPageIDFound = False
strStringBefore = ""
strRequestDate = ""
strSender = ""
strSubject = ""
strName = ""
strAddress = ""
strCityStateZip = ""
strAccountNum = ""
strInstallDate = ""
strLastEventDate = ""
strPPVHold = ""
strMonthlyRate = ""
strServices = ""
strRequestType = ""
strLanguage = ""
strCRCPIN = ""
strEventNumDateRange = ""
strSummary = ""
strVerifyBox = ""
strMDPageID = ""
lngLengthOfEmail = Len(strEmail)
lngCharPointer1 = 0
Do While (Not bSubjectFound)
strCurrentChar = Left(strEmail, 1)
If (strCurrentChar = ":") Then
'Novell
ID--------------------------------------------------------------
If (InStr(strStringBefore, "Date")) Then
If (Not bRequestDateFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <vbCr)
strRequestDate = strRequestDate & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bRequestDateFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Subject-----------------------------------------------------------
ElseIf (InStr(strStringBefore, "ubject")) Then
If (Not bSubjectFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save name until crlf
Do While (strCurrentChar <"[")
strSubject = strSubject & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bSubjectFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
Else
' Reset string before ':' and move to the next character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
Else
' Append this character to string that is before ':'
strStringBefore = strStringBefore & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
' ' Advance the character pointer
lngCharPointer1 = lngCharPointer1 + 1
Loop
Do While (Not bMDPageIDFound)
strCurrentChar = Left(strEmail, 1)
If (strCurrentChar = "]") Then
'Novell
ID--------------------------------------------------------------
If (InStr(strStringBefore, "ovell ID")) Then
If (Not bSenderFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strSender = strSender & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bSenderFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
' Else
' ' Reset string before ':' and move to the next character
' strStringBefore = ""
' strEmail = Right(strEmail, (Len(strEmail) - 1))
' End If
' Else
' ' Append this character to string that is before ':'
' strStringBefore = strStringBefore & strCurrentChar
' ' Move to the next character
' strEmail = Right(strEmail, (Len(strEmail) - 1))
' End If
' ' Advance the character pointer
' lngCharPointer1 = lngCharPointer1 + 1
'Loop
' Do While ((lngCharPointer1 <= lngLengthOfEmail))
'And (Not bSummaryFound))
' strCurrentChar = Left(strEmail, 1)
' If (strCurrentChar = "]") Then
'Name--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "s Name")) Then
If (Not bNameFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strName = strName & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bNameFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Address-------------------------------------------------------------
ElseIf (InStr(strStringBefore, "treet")) Then
If (Not bAddressFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strAddress = strAddress & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bAddressFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'City, State,
Zip--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Zip")) Then
If (Not bCityStateZipFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strCityStateZip = strCityStateZip & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bCityStateZipFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Account Number-------------------------------------------------------
ElseIf (InStr(strStringBefore, "count Number")) Then
If (Not bAccountNumFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strAccountNum = strAccountNum & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bAccountNumFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Install Date--------------------------------------------------------
ElseIf (InStr(strStringBefore, "stall Date")) Then
If (Not bInstallDateFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strInstallDate = strInstallDate & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bInstallDateFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Last Known Event
Date-------------------------------------------------------
ElseIf (InStr(strStringBefore, "Known Event Date")) Then
If (Not bLastEventDateFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strLastEventDate = strLastEventDate &
strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bLastEventDateFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'PPV Hold--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "PV Hold")) Then
If (Not bPPVHoldFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strPPVHold = strPPVHold & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bPPVHoldFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Monthly
Rate--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "onthly Rate")) Then
If (Not bMonthlyRateFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strMonthlyRate = strMonthlyRate & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bMonthlyRateFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Current
Services--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "urrent Services")) Then
If (Not bServicesFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strServices = strServices & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bServicesFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Request
Type--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "ype of Request")) Then
If (Not bRequestTypeFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strRequestType = strRequestType & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bRequestTypeFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Language------------------------------------
ElseIf (InStr(strStringBefore, "anguage")) Then
If (Not bLanguageFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strLanguage = strLanguage & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bLanguageFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'CRC Pin Instructions-------------------------------------------------
ElseIf (InStr(strStringBefore, "Pin Instructions")) Then
If (Not bCRCPINFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strCRCPIN = strCRCPIN & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bCRCPINFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Event Numbers/Date Range-----------------------
ElseIf (InStr(strStringBefore, "Date Range")) Then
If (Not bEventNumDateRangeFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strEventNumDateRange = strEventNumDateRange &
strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bEventNumDateRangeFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Summary----------------------------------------
ElseIf (InStr(strStringBefore, "ummary")) Then
If (Not bSummaryFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strSummary = strSummary & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bSummaryFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'Box Verification-------------------------------
ElseIf (InStr(strStringBefore, "Verification by Customer"))
Then
If (Not bVerifyBoxFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save address until cr
Do While (strCurrentChar <"[")
strVerifyBox = strVerifyBox & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bVerifyBoxFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'MD Page
ID--------------------------------------------------------------
ElseIf (InStr(strStringBefore, "Page ID")) Then
If (Not bMDPageIDFound) Then
' Get rid of front white space
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Do While (strCurrentChar = " ")
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Save city, state, zip until cr
Do While (strCurrentChar <"[")
strMDPageID = strMDPageID & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
strCurrentChar = Left(strEmail, 1)
lngCharPointer1 = lngCharPointer1 + 1
Loop
bMDPageIDFound = True
' Reset string before ':' and move to the next
character
strStringBefore = ""
strEmail = Right(strEmail, (Len(strEmail) - 1))
End If
'--------------------------------------------------------------------------------
End If
End If
' Else
' Append this character to string that is before ':'
strStringBefore = strStringBefore & strCurrentChar
' Move to the next character
strEmail = Right(strEmail, (Len(strEmail) - 1))
' Advance the character pointer
lngCharPointer1 = lngCharPointer1 + 1
Loop
' Clear white space, from right
If (bRequestDateFound) Then
strCurrentChar = Right(strRequestDate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strRequestDate = Left(strRequestDate, (Len(strRequestDate) -
1))
strCurrentChar = Right(strRequestDate, 1)
Loop
End If
If (bSenderFound) Then
strCurrentChar = Right(strSender, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strSender = Left(strSender, (Len(strSender) - 1))
strCurrentChar = Right(strSender, 1)
Loop
End If
If (bSubjectFound) Then
strCurrentChar = Right(strSubject, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strSubject = Left(strSubject, (Len(strSubject) - 1))
strCurrentChar = Right(strSubject, 1)
Loop
End If
If (bNameFound) Then
strCurrentChar = Right(strName, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strName = Left(strName, (Len(strName) - 1))
strCurrentChar = Right(strName, 1)
Loop
End If
If (bAddressFound) Then
strCurrentChar = Right(strAddress, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strAddress = Left(strAddress, (Len(strAddress) - 1))
strCurrentChar = Right(strAddress, 1)
Loop
End If
If (bCityStateZipFound) Then
strCurrentChar = Right(strCityStateZip, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strCityStateZip = Left(strCityStateZip, (Len(strCityStateZip) -
1))
strCurrentChar = Right(strCityStateZip, 1)
Loop
End If
If (bAccountNumFound) Then
strCurrentChar = Right(strAccountNum, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strAccountNum = Left(strAccountNum, (Len(strAccountNum) - 1))
strCurrentChar = Right(strAccountNum, 1)
Loop
End If
If (bInstallDateFound) Then
strCurrentChar = Right(strInstallDate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strInstallDate = Left(strInstallDate, (Len(strInstallDate) -
1))
strCurrentChar = Right(strInstallDate, 1)
Loop
End If
If (bLastEventDateFound) Then
strCurrentChar = Right(strLastEventDate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strLastEventDate = Left(strLastEventDate,
(Len(strLastEventDate) - 1))
strCurrentChar = Right(strLastEventDate, 1)
Loop
End If
If (bPPVHoldFound) Then
strCurrentChar = Right(strPPVHold, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strPPVHold = Left(strPPVHold, (Len(strPPVHold) - 1))
strCurrentChar = Right(strPPVHold, 1)
Loop
End If
If (bMonthlyRateFound) Then
strCurrentChar = Right(strMonthlyRate, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strMonthlyRate = Left(strMonthlyRate, (Len(strMonthlyRate) -
1))
strCurrentChar = Right(strMonthlyRate, 1)
Loop
End If
If (bServicesFound) Then
strCurrentChar = Right(strServices, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strServices = Left(strServices, (Len(strServices) - 1))
strCurrentChar = Right(strServices, 1)
Loop
End If
If (bRequestTypeFound) Then
strCurrentChar = Right(strRequestType, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strRequestType = Left(strRequestType, (Len(strRequestType) -
1))
strCurrentChar = Right(strRequestType, 1)
Loop
End If
If (bLanguageFound) Then
strCurrentChar = Right(strLanguage, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strLanguage = Left(strLanguage, (Len(strLanguage) - 1))
strCurrentChar = Right(strLanguage, 1)
Loop
End If
If (bCRCPINFound) Then
strCurrentChar = Right(strCRCPIN, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strCRCPIN = Left(strCRCPIN, (Len(strCRCPIN) - 1))
strCurrentChar = Right(strCRCPIN, 1)
Loop
End If
If (bEventNumDateRangeFound) Then
strCurrentChar = Right(strEventNumDateRange, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strEventNumDateRange = Left(strEventNumDateRange,
(Len(strEventNumDateRange) - 1))
strCurrentChar = Right(strEventNumDateRange, 1)
Loop
End If
If (bSummaryFound) Then
strCurrentChar = Right(strSummary, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strSummary = Left(strSummary, (Len(strSummary) - 1))
strCurrentChar = Right(strSummary, 1)
Loop
End If
If (bVerifyBoxFound) Then
strCurrentChar = Right(strVerifyBox, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strVerifyBox = Left(strVerifyBox, (Len(strVerifyBox) - 1))
strCurrentChar = Right(strVerifyBox, 1)
Loop
End If
If (bMDPageIDFound) Then
strCurrentChar = Right(strMDPageID, 1)
Do While (strCurrentChar = " ")
' Advance 1 char, from right
strMDPageID = Left(strMDPageID, (Len(strMDPageID) - 1))
strCurrentChar = Right(strMDPageID, 1)
Loop
End If
Me.txtStatusBar.Value = "Parsing...Complete."
'Debug.Print _
' "Name Found: " & bNameFound & "["Lf & _
' "Name: " & strName & "["Lf & "["Lf & _
' "Address Found: " & bAddressFound & "["Lf & _
' "Address: " & strAddress & "["Lf & "["Lf & _
' "City, State, Zip Found: " & bCityStateZipFound & "["Lf & _
' "City, State, Zip: " & strCityStateZip
If (bNameFound And bAddressFound And bCityStateZipFound And
bSubjectFound And bAccountNumFound) Then
Me.txtStatusBar.Value = "Creating record..."
' Found all the fields
Set dbDatabase = CurrentDb()
Set rsRecordset = dbDatabase.OpenRecordset("tblCustomers")
'Create a new record with parsed info----------------------------------
rsRecordset.AddNew
rsRecordset.Fields(1).Value = Trim(strRequestDate)
rsRecordset.Fields(2).Value = Mid(strSender, 3)
rsRecordset.Fields(3).Value = Trim(strSubject)
rsRecordset.Fields(4).Value = Mid(strName, 3)
rsRecordset.Fields(5).Value = Mid(strAddress, 3)
rsRecordset.Fields(6).Value = Mid(strCityStateZip, 3)
rsRecordset.Fields(7).Value = Mid(strAccountNum, 3)
rsRecordset.Fields(8).Value = Trim(strInstallDate)
rsRecordset.Fields(9).Value = Trim(strLastEventDate)
rsRecordset.Fields(10).Value = Mid(strPPVHold, 3)
rsRecordset.Fields(11).Value = Trim(strMonthlyRate)
rsRecordset.Fields(12).Value = Mid(strServices, 3)
rsRecordset.Fields(13).Value = Mid(strRequestType, 3)
rsRecordset.Fields(14).Value = Mid(strLanguage, 3)
rsRecordset.Fields(15).Value = Mid(strCRCPIN, 3)
rsRecordset.Fields(16).Value = Mid(strEventNumDateRange, 3)
rsRecordset.Fields(17).Value = Mid(strSummary, 3)
rsRecordset.Fields(18).Value = Mid(strVerifyBox, 3)
rsRecordset.Fields(19).Value = Mid(strMDPageID, 3)
rsRecordset.Update
rsRecordset.Close
Set rsRecordset = Nothing
dbDatabase.Close
Set dbDatabase = Nothing
Else
'Could not find all or some of the fields
'Add incomplete record to exceptions table for manual processing.
Set dbDatabase = CurrentDb()
Set rsRecordset = dbDatabase.OpenRecordset("tblExceptions")
rsRecordset.AddNew
rsRecordset.Fields(1).Value = Me.txtEmail.Value
rsRecordset.Fields(2).Value = Now()
rsRecordset.Update
rsRecordset.Close
Set rsRecordset = Nothing
dbDatabase.Close
Set dbDatabase = Nothing
'MsgBox "Could not find a field. Please try again.", vbExclamation
+ vbOKOnly
End If
' Clear email field and get ready for another one
Me.txtEmail.Value = Null
Me.txtEmail.SetFocus
Kill "C:\MailSave\GetInfo.txt"
Loop
DoCmd.SetWarnings False
DoCmd.OpenQuery "qry_ConvertNewData_1", acViewNormal, acEdit
DoCmd.OpenQuery "qry_ConvertNewData_2", acViewNormal, acEdit
DoCmd.OpenQuery "qry_ConvertNewData_2a", acViewNormal, acEdit
DoCmd.OpenQuery "qry_ConvertNewData_3", acViewNormal, acEdit
DoCmd.OpenQuery "qry_AppendNewWork", acViewNormal, acEdit
DoCmd.OpenQuery "qry_DeleteParsed", acViewNormal, acEdit
Me.txtStatusBar.Value = "Creating record...Complete."
Exit_cmdParse_Click:
Exit Sub
End Sub
