Go Premium for a chance to win a PS4. Enter to Win

x
?
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
Medium Priority
?
535 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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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 93

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 93

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 2000 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
 

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

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Suggested Courses

972 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