Solved

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

Posted on 2008-10-06
25
498 Views
Last Modified: 2013-11-27
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.
0
Comment
Question by:ellizz
  • 13
  • 7
  • 2
  • +2
25 Comments
 
LVL 25

Expert Comment

by:Luis Pérez
ID: 22657034
Please post the complete code.
0
 
LVL 22

Expert Comment

by:Kelvin Sparks
ID: 22657058
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
 

Author Comment

by:ellizz
ID: 22657868
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
 
LVL 22

Expert Comment

by:Kelvin Sparks
ID: 22657878
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
 

Author Comment

by:ellizz
ID: 22657997
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
 

Author Comment

by:ellizz
ID: 22658315
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
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 22659460
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
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 22659482
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
 

Author Comment

by:ellizz
ID: 22659945
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
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 22662347
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
 

Author Comment

by:ellizz
ID: 22662892
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
 
LVL 16

Accepted Solution

by:
Chuck Wood earned 500 total points
ID: 22663496
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:ellizz
ID: 22664750
Thank you
I have tried using this but; stops at this line Replace(astrMessageText(0),"Name: ","")  and says expected array
0
 

Author Comment

by:ellizz
ID: 22664801
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
 

Author Comment

by:ellizz
ID: 22664824
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
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 22668108
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
 

Author Comment

by:ellizz
ID: 22668456
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
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 22668502
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
 

Author Comment

by:ellizz
ID: 22668559
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
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 22668695
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
 

Author Comment

by:ellizz
ID: 22669546
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
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 22669647
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
 

Author Comment

by:ellizz
ID: 22669733
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
 

Author Closing Comment

by:ellizz
ID: 31503713
Thank you again for your help with this :)
0
 
LVL 16

Expert Comment

by:Chuck Wood
ID: 22670033
You're welcome.

-Chuck
0

Featured Post

Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

Join & Write a Comment

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now