When I run my script it gives error on the following line:
strEmail = Right(strEmail, (Len(strEmail) - 1))
I enclose my code and the sample text file too
Thanks,
-----------------------------------------------------------------------------
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 bSummaryFound As Boolean
Dim bServicesFound As Boolean
Dim strVerifyBox As String
Dim bMonthlyRateFound As Boolean
Dim bRequestTypeFound As Boolean
Dim strServices As String
Dim bLanguageFound As Boolean
Dim bLastEventDateFound As Boolean
Dim strMonthlyRate As String
Dim bPPVHoldFound As Boolean
Dim strLastEventDate As String
Dim bMDPageIDFound As Boolean
Dim strInstallDate As String
Dim strLanguage As String
Dim bInstallDateFound As Boolean
Dim bNameFound As Boolean
Dim strEventNumDateRange As String
Dim bAddressFound As Boolean
Dim bCityStateZipFound As Boolean
Dim bVerifyBoxFound As Boolean
Dim bSubjectFound As Boolean
Dim strMDPageID As String
Dim bReturnMethodFound As Boolean
Dim bAccountNumFound As Boolean
Dim bReturnDateFound As Boolean
Dim strCRCPIN As String
Dim bCommentsFound As Boolean
Dim bBoxTypeFound As Boolean
Dim strRequestType As String
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 bEventNumDateRangeFound As Boolean
Dim lngCharPointer1 As Long
Dim lngCharPointer2 As Long
Dim dbDatabase As DAO.Database
Dim rsRecordset As DAO.Recordset
Dim bCRCPINFound As Boolean
Dim strPPVHold As String
Dim strSummary As String
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
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 subject 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 name 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
'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 <"[")
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
'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 <"[")
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
'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
'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 <"[")
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 <"[")
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 <"[")
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 <"[")
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 <"[")
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
'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))
'I COMPARE THESE LINES------------------------------
' 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
---------------------------------------------------------------------------------SAMPLE
TEXT FILE
Date: 2006-08-10-13-38-47
To: Stephen_Ng
From: <KDB Shared Services>
Subject: Box Credit - 501756
[Date]
Thu Aug 10 13:38:45 EDT 2006
[Novell ID]
SNG
[Subject]
Box Credit - 501756
[Customer's Name]
DIOMARIS GRULLON
[Street]
29 STUYVESANT AV APT 3
[City, State, Zip]
BROOKLYN NY, 11221
[Account Number]
07836-105575-02
[Corp]
7836
[Amount to Credit]
123
[Return Method]
Tech
[Tech Number]
123
[Date Returned]
08/10/2006
[Type of Equipment]
Digital
[Number of Boxes]
1
[Converter Numbers]
123
[Comments]
test
[Control Number]
658006
