Problem with overflow in access module, when I debug goes to line incount = incount + 1. However I am not trying to read in anything below or above that access can't take

I have set up a linked table in access to link with a folder in my inbox to read in those messages.  I am trying now to read the body of the message in the linked table to split it into Forename, Surname, Address and read this into a contact table with those three fields.
To look through the message I have :
End If
           
           
intCount = intCount + 1

Loop
when I run the module I get error 6 overflow and it goes to the incount = incount + 1 line.

I only have one email read in the linked table to test so don't see how can be having overflow with too large bytes being read, so confused how to solve this, any suggestions would be appreciated.
ellizzAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
Chuck WoodConnect With a Mentor Commented:
Here is how I would handle it:
Dim astrMessageText() As String
' load the message into the array by splitting it on new line characters
astrMessageText=Split(strMessageText,vbNewLine)
' replace the unneeded indicators
astrMessageText(0) = Replace(astrMessageText(0),"Name: ","")
astrMessageText(1) = Replace(astrMessageText(1),"Email: ","")
astrMessageText(2) = Replace(astrMessageText(2),"Year_Qualified: ","")
astrMessageText(3) = Replace(astrMessageText(3),"Clinician_Type: ","")
astrMessageText(4) = Replace(astrMessageText(4),"Directorate: ","")
astrMessageText(5) = Replace(astrMessageText(5),"Phone_Number: ","")
astrMessageText(6) = Replace(astrMessageText(6),"Bleep_Number: ","")
astrMessageText(7) = Replace(astrMessageText(7),"Participating: ","")
' create the SQL string
strSQL = "Insert Into ContactData(Name, Email, Year_Qualified,Clinician_Type,Directorate,Phone_Number,Bleep_Number,Participating) Values ('" & astrMessageText(0) & "'"
strSQL = strSQL & ",'" & astrMessageText(1) & "'"
strSQL = strSQL & ",'" & astrMessageText(2) & "'"
strSQL = strSQL & ",'" & astrMessageText(3) & "'"
strSQL = strSQL & ",'" & astrMessageText(4) & "'"
strSQL = strSQL & ",'" & astrMessageText((5) & "'"
strSQL = strSQL & ",'" & astrMessageText((6) & "'"
strSQL = strSQL & ",'" & astrMessageText(7) & "'"
strSQL = strSQL & ")"
' insert the data into the table
CurrentProject.Connection.Execute strSQL 

Open in new window

0
 
Luis PérezSoftware Architect in .NetCommented:
Please post the complete code.
0
 
Kelvin SparksCommented:
Have you code to stop the loop when all messages are read or is the loop just going & going & going.....

I suspect intCount is an integer which will crash when trying to exceed 32768.

Kelvin
0
Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

 
ellizzAuthor Commented:
How do I stop the loop, sorry been ages since I used vb so struggling

I just simply have it start when incount =1 and then the loop is incount = incount +1 loop and you are right wit the 32768 as that is the numbers it says when i hover my mouse over incount when debug
0
 
Kelvin SparksCommented:
You would need to know what you are looping through.

Using it would be a recordset or similar of selected records and be something like DoUntil rs.EOF

Or

Do Until intCount = rs.count +1

Kelvin
0
 
ellizzAuthor Commented:
I thought probably easier for you to see what i'm doing as thinking about it maybe the loop on mu onclick on the command button is causing it too.

the file readbody is the module, have included up to where it stops when it gives the error it goes to the incount=incount+1 so not sure how I should chnage the loop to stop it overflowing and reading the messgae.

The file commandbuttonclick is what happens when you click the command button on the form to get the body message split and into table

thanks for your help
readbody.txt
commandbuttonclick.txt
0
 
ellizzAuthor Commented:
module that getting the overflow error on line incount=incount+1
Function Readbody(strMessageText As String)

Dim strName As String
Dim strEmail As String
Dim strYear As String
Dim strClinician As String
Dim strDirectorate As String
Dim strPhone As String
Dim strBleep As String
Dim strParticipating As String
Dim stSQL As String
Dim stData  As String

Dim intCount As Integer
Dim intStop As Integer

intCount = 1
intStop = Len(strMessageText)


Do Until Len(strMessageText) = 1

stData = Left(strMessageText, intCount)
If Right(stData, 1) = vbLf Then
    Select Case Left(stData, 5)
        Case "Name"
            strName = Replace(stData, "Name: ", "")
        Case "Email:"
            strName = Replace(stData, "Email: ", "")
        Case "Year"
            strYear = Replace(stData, "Year_Qualified: ", "")
        Case "Clinician"
            strClinician = Replace(stData, "Clinician_Type: ", "")
        Case "Directorate:"
            strDirectorate = Replace(stData, "Directorate: ", "")
        Case "Phone"
            strPhone = Replace(stData, "Phone_Number: ", "")
        Case "Bleep: "
            strBleep = Replace(stData, "Bleep_Number: ", "")
        Case "Participating"
            strParticipating = Replace(stData, "Participating: ", "")
            strMessageText = "X"
    End Select
    strMessageText = Right(strMessageText, intStop - intCount)
    intCount = 1
    intStop = Len(strMessageText)
End If
           
           iintCount = intCount + 1
Loop


strSQL = "Insert Into ContactData(Name, Email, Year_Qualified,Clinician_Type,Directorate,Phone_Number,Bleep_Number,Participating) Values ('" & strName & "'"
strSQL = strSQL & ",'" & strEmail & "'"
strSQL = strSQL & ",'" & strYear & "'"
strSQL = strSQL & ",'" & strClinician & "'"
strSQL = strSQL & ",'" & strDirectorate & "'"
strSQL = strSQL & ",'" & strPhone & "'"
strSQL = strSQL & ",'" & strBleep & "'"
strSQL = strSQL & ",'" & strParticipating & "'"
strSQL = strSQL & ")"

strSQL = Replace(Replace(strSQL, vbCr, ""), vbLf, "")

DoCmd.SetWarnings False

DoCmd.RunSQL (strSQL)

DoCmd.SetWarnings True

End Function
0
 
Patrick MatthewsCommented:
ellizz said:
>>           iintCount = intCount + 1

That may be your problem: you misspelled a variable.

To keep that from happening again, set your VBA options to always require variable declaration (that forces
a module declaration Option Explicit in every new module).
0
 
Patrick MatthewsCommented:
ellizz,

BTW, I never use Byte or Integer any more as data types, and use Long instead.  Part of that is because
most of my coding is in Excel, where I sometimes have to process 32,768+ rows.  Part of it is that,
internally, VBA has to implicitly convert Byte or Integer values into Long and then convert them back to
Byte or Integer after finishing an operation, so using those smaller data types can actually slow down
your code.  Not that you are likely to notice the difference, unless your running time is measured in hours...

:)

Regards,

Patrick
0
 
ellizzAuthor Commented:
Sorry I just miss spelt in on the code I put up on here.  It is correct in the module and still brings up the overflow error.
Here is correct one running now still with overflow problem:

Function Readbody(strMessageText As String)

Dim strName As String
Dim strEmail As String
Dim strYear As String
Dim strClinician As String
Dim strDirectorate As String
Dim strPhone As String
Dim strBleep As String
Dim strParticipating As String
Dim stSQL As String
Dim stData  As String

Dim intCount As Integer
Dim intStop As Integer

intCount = 1
intStop = Len(strMessageText)


Do Until Len(strMessageText) = 1

stData = Left(strMessageText, intCount)
'If Right(stData, 1) = vbLf Then
    Select Case Left(stData, 5)
        Case "Name"
            strName = Replace(stData, "Name: ", "")
        Case "Email:"
            strName = Replace(stData, "Email: ", "")
        Case "Year"
            strYear = Replace(stData, "Year_Qualified: ", "")
        Case "Clinician"
            strClinician = Replace(stData, "Clinician_Type: ", "")
        Case "Directorate:"
            strDirectorate = Replace(stData, "Directorate: ", "")
        Case "Phone"
            strPhone = Replace(stData, "Phone_Number: ", "")
        Case "Bleep: "
            strBleep = Replace(stData, "Bleep_Number: ", "")
        Case "Participating"
            strParticipating = Replace(stData, "Participating: ", "")
            strMessageText = "X"
    End Select
    strMessageText = Right(strMessageText, intStop - intCount)
    intCount = 1
    intStop = Len(strMessageText)
End If
           
           
intCount = intCount + 1
Loop


strSQL = "Insert Into ContactData(Name, Email, Year_Qualified,Clinician_Type,Directorate,Phone_Number,Bleep_Number,Participating) Values ('" & strName & "'"
strSQL = strSQL & ",'" & strEmail & "'"
strSQL = strSQL & ",'" & strYear & "'"
strSQL = strSQL & ",'" & strClinician & "'"
strSQL = strSQL & ",'" & strDirectorate & "'"
strSQL = strSQL & ",'" & strPhone & "'"
strSQL = strSQL & ",'" & strBleep & "'"
strSQL = strSQL & ",'" & strParticipating & "'"
strSQL = strSQL & ")"

strSQL = Replace(Replace(strSQL, vbCr, ""), vbLf, "")

DoCmd.SetWarnings False

DoCmd.RunSQL (strSQL)

DoCmd.SetWarnings True

End Function

0
 
Chuck WoodCommented:
If the length of strMessageText never is 1 character, intCount will continue to increment by 1 until it overflows. Are you sure that the length of strMessageText will become 1 character?
0
 
ellizzAuthor Commented:
Not sure,
This is how the email message is:
Name: anoy
Email: anoy@any.com
Year_Qualified: 1233
Clinician_Type: Doctor
Directorate: Cancer ward
Phone_Number: 2332
Bleep_Number: 33
Participating: yes

this is what im trying to read from each message.  so what should the strmessagetext =? or is there a way to chnage the code to read the body of athe email?
thanks
0
 
ellizzAuthor Commented:
Thank you
I have tried using this but; stops at this line Replace(astrMessageText(0),"Name: ","")  and says expected array
0
 
ellizzAuthor Commented:
managed to solve that now but; now it runs to CurrentProject.Connection.Execute strSQL and says
runtime error -217217833 the field is too small to accept this size data you attempted to add.  Confused as each field is not much as just forename, surname etc of people being read and going into the table
0
 
ellizzAuthor Commented:
Hi
I took CurrentProject.....and it is now working :) thank you for your help.  Just one final thing though, how do I get it to not keep loading the same info as each time I click the command button it reloads the information so I end up with duplicates of all each time.
0
 
Chuck WoodCommented:
Are you passing the Readbody function a different strMessageText each time? If you pass it the same strMessageText, it will load the same data. If you are passing the same strMessageText, please post you new code here.

-Chuck
0
 
ellizzAuthor Commented:
No I'm not but; unsure how to do that.
My code when you click the command button to do this which then calls the readboy module is this (not sure if maybe this is where I need to make sure im not passing the same:
Private Sub Command0_Click()
Dim db As Database
Dim rs As Recordset
Dim stSQL As String

stSQL = "Select * from Inbox" 'where Subject = 'Registration'"

Set db = CurrentDb
Set rs = db.OpenRecordset(stSQL)

If rs.RecordCount = 0 Then GoTo CleanUp

rs.MoveLast
rs.MoveFirst
Do Until rs.EOF


Readbody (rs!contents)

rs.MoveNext
Loop
     
CleanUp:
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing

End Sub
The module code to search the body of email to take out and load into the table is:
Function Readbody(strMessageText As String)

Dim strName As String
Dim strEmail As String
Dim strYear As String
Dim strClinician As String
Dim strDirectorate As String
Dim strPhone As String
Dim strBleep As String
Dim strParticipating As String
Dim stSQL As String
Dim stData  As String




Dim astrMessageText() As String
' load the message into the array by splitting it on new line characters
astrMessageText = Split(strMessageText, vbNewLine)
' replace the unneeded indicators
astrMessageText(0) = Replace(astrMessageText(0), "Name: ", "")
astrMessageText(1) = Replace(astrMessageText(1), "Email: ", "")
astrMessageText(2) = Replace(astrMessageText(2), "Year_Qualified: ", "")
astrMessageText(3) = Replace(astrMessageText(3), "Clinician_Type: ", "")
astrMessageText(4) = Replace(astrMessageText(4), "Directorate: ", "")
astrMessageText(5) = Replace(astrMessageText(5), "Phone_Number: ", "")
astrMessageText(6) = Replace(astrMessageText(6), "Bleep_Number: ", "")
astrMessageText(7) = Replace(astrMessageText(7), "Participating: ", "")


' create the SQL string
strSQL = "Insert Into ContactData(Name, Email, Year_Qualified,Clinician_Type,Directorate,Phone_Number,Bleep_Number,Participating) Values ('" & astrMessageText(0) & "'"
strSQL = strSQL & ",'" & astrMessageText(1) & "'"
strSQL = strSQL & ",'" & astrMessageText(2) & "'"
strSQL = strSQL & ",'" & astrMessageText(3) & "'"
strSQL = strSQL & ",'" & astrMessageText(4) & "'"
strSQL = strSQL & ",'" & astrMessageText(5) & "'"
strSQL = strSQL & ",'" & astrMessageText(6) & "'"
strSQL = strSQL & ",'" & astrMessageText(7) & "'"
strSQL = strSQL & ")"
' insert the data into the table
'CurrentProject.Connection.Execute strSQL
strSQL = Replace(Replace(strSQL, vbCr, ""), vbLf, "")

DoCmd.SetWarnings False

DoCmd.RunSQL (strSQL)

DoCmd.SetWarnings True

End Function


so it all works but; yes it reads in them all again so keeps duplicating old ones as well as adding new
0
 
Chuck WoodCommented:
If you don't move the old messages out of your Inbox, you will get the same messages loaded each time. You might want to move these old messages into another container, perhaps a folder you create names Registrations or a folder in a Personal Folder.
0
 
ellizzAuthor Commented:
can it not be done by looking in the contactdata table and seeing if the record exisits and if it does do not put in to make it more automated? If so do you know how I could do this?
0
 
Chuck WoodCommented:
Try this code for the function.

-Chuck
Function Readbody(strMessageText As String)
    Dim stSQL As String, astrMessageText() As String
    Dim db As Database, rs As Recordset
    Set db = CurrentDb
    ' load the message into the array by splitting it on new line characters
    astrMessageText = Split(strMessageText, vbNewLine)
    ' replace the unneeded indicators
    astrMessageText(0) = Replace(astrMessageText(0), "Name: ", "")
    astrMessageText(1) = Replace(astrMessageText(1), "Email: ", "")
    astrMessageText(2) = Replace(astrMessageText(2), "Year_Qualified: ", "")
    astrMessageText(3) = Replace(astrMessageText(3), "Clinician_Type: ", "")
    astrMessageText(4) = Replace(astrMessageText(4), "Directorate: ", "")
    astrMessageText(5) = Replace(astrMessageText(5), "Phone_Number: ", "")
    astrMessageText(6) = Replace(astrMessageText(6), "Bleep_Number: ", "")
    astrMessageText(7) = Replace(astrMessageText(7), "Participating: ", "")
    ' create the SQL string to check if this is a duplicate
    strSQL = "SELECT * FROM ContactData WHERE Name='" & astrMessageText(0) & _
        "' AND Email='" & astrMessageText(1) & _
        "' AND Year_Qualified='" & astrMessageText(2) & _
        "' AND Clinician_Type='" & astrMessageText(3) & _
        "' AND Directorate='" & astrMessageText(4) & _
        "' AND Phone_Number='" & astrMessageText(5) & _
        "' AND Bleep_Number='" & astrMessageText(6) & _
        "' AND Participating='" & astrMessageText(7) & "'"
    ' try to get the record that matches this message string
     Set rs = db.OpenRecordset(stSQL)
     ' if there was no record that matches,
     If rs.RecordCount = 0 Then
        ' create the SQL string to insert a new record
        strSQL = "Insert Into ContactData(Name, Email, Year_Qualified, " & _
            "Clinician_Type,Directorate,Phone_Number,Bleep_Number,Participating) " & _
            "Values ('" & astrMessageText(0) & "'"
        strSQL = strSQL & ",'" & astrMessageText(1) & "'"
        strSQL = strSQL & ",'" & astrMessageText(2) & "'"
        strSQL = strSQL & ",'" & astrMessageText(3) & "'"
        strSQL = strSQL & ",'" & astrMessageText(4) & "'"
        strSQL = strSQL & ",'" & astrMessageText(5) & "'"
        strSQL = strSQL & ",'" & astrMessageText(6) & "'"
        strSQL = strSQL & ",'" & astrMessageText(7) & "'"
        strSQL = strSQL & ")"
        ' insert the data into the table
        strSQL = Replace(Replace(strSQL, vbCr, ""), vbLf, "")
        DoCmd.SetWarnings False
        DoCmd.RunSQL (strSQL)
        DoCmd.SetWarnings True
    End If
End Function

Open in new window

0
 
ellizzAuthor Commented:
Hi,
thank you, i tried it and it says the microsoft jet engine cannot find the input table or query and when debig goes to:
     Set rs = db.OpenRecordset(stSQL)
says check name matches
0
 
Chuck WoodCommented:
Please try this:

Right after
strSQL = "SELECT * FROM ContactData WHERE Name='" & astrMessageText(0) & _
        "' AND Email='" & astrMessageText(1) & _
        "' AND Year_Qualified='" & astrMessageText(2) & _
        "' AND Clinician_Type='" & astrMessageText(3) & _
        "' AND Directorate='" & astrMessageText(4) & _
        "' AND Phone_Number='" & astrMessageText(5) & _
        "' AND Bleep_Number='" & astrMessageText(6) & _
        "' AND Participating='" & astrMessageText(7) & "'"

Put this:
Debug.Print strSQL
Stop

Copy the SQL string that was printed in the Immediate window (Ctrl+G) and post it here.
0
 
ellizzAuthor Commented:
hi,
sorry was just about to put a message up, the reason it wasnt working was because strsql qas spelt wrong when it was declared as Dim stSQL As String and here Set rs = db.OpenRecordset(stSQL)

thats all it was, added the r and it works perfectly

thank you again for all your help :)
0
 
ellizzAuthor Commented:
Thank you again for your help with this :)
0
 
Chuck WoodCommented:
You're welcome.

-Chuck
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.