Vb-access runtime error 3001

[bobykuriakose12]

VB-ACCESS RUNTIME ERROR 3001

---

DEAR SIR,

I AM A STUDENT IN VISUAL BASIC.I AM TRYING TO INSERT IMAGE ON VB FORM(GETCHUNK--METHOD),IT IS SUCCESSFULLY SAVED AND TRYING TO RETRIEVE IN SAME TIME ITS OK AND TRYING TO EDIT THAT FORM AND TRYING TO SAVE,ITS WORKING BUT CREATE A SAME ANOTHER ENTRY ON DATABASE.BUT IF I CLOSED THAT APPLICATION,BUT AFTER RE-LOGIN, ITS NOT RETRIVING.AT THAT TIME SHOW ERROR MESSAGE ----(RUN-TIME ERROR-3001 ARGUMENTS ARE OF THE WRONG TYPE,ARE OUT OF ACCEPTABLE RANGE,OR ARE IN CONFLICT WITH ONE ANOTHER)--- .I AM ALSO ATTACHED MY SOURCE CODE.CAN U PLS ANSWER MY REQUEST.

REGARDS
BOBY KURIAKOSE

-----------------------------


Option Explicit

Const BLOCK_SIZE As Long = 100000 'bytes

Dim cnnEmp As ADODB.Connection
Dim rsEMP As ADODB.Recordset

Dim fileSize As Long
Dim fileName As String
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
Dim rs5 As New ADODB.Recordset
Dim i As Integer
Dim s As String
Dim sql As String



Private Sub cmdadd_Click()

txtbalamt.Text = "0"
sql = "select max(regno) as rn from studentdetails"
If rs1.State Then
rs1.Close
End If
rs1.Open sql, cn, adOpenKeyset, adLockOptimistic
If rs1.RecordCount = 0 Then
txtregno.Text = "1"
Else
txtregno.Text = Int(rs1.Fields("rn")) + 1
End If
t

Private Sub cmdsearch_Click()
MSFlexGrid1.Rows = 1
MSFlexGrid1.Visible = True
If rs5.State Then
rs5.Close
End If

i = 1
MSFlexGrid1.TextMatrix(0, 0) = "RegNo"
MSFlexGrid1.TextMatrix(0, 1) = "NAME"
If Optname.Value = True Then
sql = "select * from studentdetails where name like '" & "%" & Trim(txtsrchname.Text) & "%" & "'"
rs5.Open sql, cn, adOpenKeyset, adLockOptimistic
While Not rs5.EOF
MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
MSFlexGrid1.TextMatrix(i, 0) = rs5.Fields!RegNo
MSFlexGrid1.TextMatrix(i, 1) = rs5.Fields!Name

rs5.MoveNext
i = i + 1

Wend
End If


Private Sub Form_Load()

Optname.Value = True
txtsrchname.Enabled = True
cmddelete.Enabled = False
cmdadd.Enabled = True
cmdedit.Enabled = False
cmdsave.Enabled = False
cmdsearch.Enabled = True
MSFlexGrid1.ColWidth(0) = 0
MSFlexGrid1.Visible = False



DTPlearto.Enabled = False
Set cnnEmp = New ADODB.Connection
Set rsEMP = New ADODB.Recordset

'Open the Database connection
With cnnEmp
.Provider = "microsoft.jet.oledb.4.0"
.CursorLocation = adUseClient
.Open App.Path & "\data.mdb"
End With

' Open the EMP table.
Dim sSQL As String
sSQL = "select * " & _
" from studentdetails"

With rsEMP
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open sSQL, cnnEmp
End With

ClearFields

End Sub




Private Sub ClearFields()

Dim con As Control

For Each con In Controls
If TypeOf con Is TextBox Then
con.Text = ""
ElseIf TypeOf con Is Image Then
con.Picture = Nothing
End If
Next

End Sub



Private Function ValidateData() As Boolean


ValidateData = True
'End If

End Function



Private Sub FillFields()

Me.MousePointer = vbHourglass







txtregno = "" & rsEMP("RegNo")
txtlearnearsno = "" & rsEMP("learnersno")

DTPmy3 = "" & rsEMP("mydate3")

DTPmy4 = "" & rsEMP("mydate4")


ReadPictureData

Me.MousePointer = vbNormal

End Sub


Private Sub ReadPictureData()

Dim diskFile As String
diskFile = App.Path & "\temp\emp.bmp"

Dim tempDir As String
tempDir = Dir(App.Path & "\temp", vbDirectory)

If tempDir = "" Then
MkDir App.Path & "\temp"
End If

' Delete the temp picture file.
If Len(Dir$(diskFile)) > 0 Then
Kill diskFile
End If

'Get the Phot size
fileSize = rsEMP("Photo").ActualSize

'Get a free file handle
Dim destfileNum As Long
destfileNum = FreeFile

'Open the file
Open diskFile For Binary As destfileNum

'Calculate the number of blocks (100000 bytes blocks)
Dim pictBlocks As Integer
pictBlocks = fileSize / BLOCK_SIZE

'Calculate the left over data
Dim leftOverData As Long
leftOverData = fileSize Mod BLOCK_SIZE

'Byte array for Picture data.
Dim pictData() As Byte
'Get the left over data first
pictData() = rsEMP("Photo").GetChunk(leftOverData)

'write the binary picture data from a variable to disk file
Put destfileNum, , pictData()

Dim i

'Now get the remaining binary picture data in Blocks of 100000
For i = 1 To pictBlocks
pictData() = rsEMP("Photo").GetChunk(BLOCK_SIZE)
Put destfileNum, , pictData()
Next i

'Close the file handle
Close destfileNum

'Load the temp Picture into the Image control
Image1.Picture = LoadPicture(App.Path & "\temp\emp.bmp")

End Sub

Private Sub cmdSave_Click()

' This procedure Saves the employee information to the DB.
' converts that Image file to a Byte array, and saves the Byte
' Array to the table using the Appendchunk method.

'Validate the employee information
If ValidateData = False Then

Exit Sub

Else

Me.MousePointer = vbHourglass

'Get a Free file handle
Dim sourceFile As Integer
sourceFile = FreeFile

'Open the Photo
Open fileName For Binary Access Read As sourceFile

'Get the size of the file in bytes
fileSize = LOF(sourceFile)

If fileSize = 0 Then

Close sourceFile

MsgBox "Employee's Photo is invalid"
Exit Sub

Else

'Calculate the number of blocks (100000 bytes blocks)
Dim pictBlocks As Integer
pictBlocks = fileSize / BLOCK_SIZE

'Calculate the left over data
Dim leftOverData As Long
leftOverData = fileSize Mod BLOCK_SIZE

'Byte array for Picture data.
Dim pictData() As Byte
ReDim pictData(leftOverData)

'Reads data from an open disk file into pictData()
Get sourceFile, , pictData()


'Save the Employee Information
rsEMP.AddNew
'Appends the Left Over binary picture data to the Photo field
'in the employee table
rsEMP("Photo").AppendChunk pictData()

ReDim pictData(BLOCK_SIZE)

Dim i As Integer

For i = 1 To pictBlocks
'Read the picture data in blocks of 100000 bytes
Get sourceFile, , pictData()
'appends the binary picture data the Photo field
rsEMP("Photo").AppendChunk pictData()
Next i

' rsEMP("FirstName") = txtFName
'rsEMP("MiddleName") = txtMName
'rsEMP("LastName") = txtLName
'rsEMP("SSN") = txtSSN
'rsEMP("Notes") = txtNotes

'Update the data

rsEMP("RegNo") = txtregno.Text
ELSE
rsEMP("instamt8") = 0
End If

End If

rsEMP.Update

'close the file handle
Close sourceFile

End If

Me.MousePointer = vbNormal

'Clear the form
ClearFields

MsgBox "Students information successfully saved"

End If

End Sub

Private Sub Image1_DblClick()

' Retrieve the picture and update the record.
CommonDialog1.Filter = "(*.bmp;*.ico;*.gif;*.jpg)|*.bmp;*.ico;*.gif;* .jpg "
CommonDialog1.ShowOpen

fileName = CommonDialog1.fileName

If fileName <> "" Then
Set Image1.Picture = LoadPicture(fileName)
End If

End Sub

'v1.1 changes
Private Sub Image1_OLEDragOver(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single, _
State As Integer)

'vset a drag drop effect
If Data.GetFormat(vbCFFiles) Then
Effect = vbDropEffectCopy And Effect
Exit Sub
End If

Effect = vbDropEffectNone

End Sub



Private Sub Image1_OLEDragDrop(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)

'if File list from Windows Explorer
If Data.GetFormat(vbCFFiles) Then

Dim vFN

For Each vFN In Data.Files
Dim fileExt As String

'get the file ext
fileExt = Mid(vFN, InStrRev(vFN, ".") + 1, Len(vFN))

Select Case UCase(fileExt)
Case "BMP", "GIF", "JPEG", "JPG", "WMF", "TIF", "PNG"
Set Image1.Picture = LoadPicture(vFN)
fileName = vFN
End Select

Next vFN

End If

End Sub
'end of v1.1 changes

Private Sub MSFlexGrid1_DblClick()
cmdedit.Enabled = True
cmddelete.Enabled = True
cmdadd.Enabled = True
cmdsave.Enabled = False
cmdsearch.Enabled = True
MSFlexGrid1.Visible = False
If rs2.State Then
rs2.Close
End If

sql = "select * from studentdetails where RegNo=" & Trim(MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)) & ""
rs2.Open sql, cn, adOpenKeyset, adLockOptimistic
If rs2.RecordCount > 0 Then
With rs2

Me.MousePointer = vbHourglass

'txtFName = "" & rsEMP("FirstName")
'txtLName = "" & rsEMP("LastName")
'txtMName = "" & rsEMP("MiddleName")
'txtSSN = "" & rsEMP("SSN")
'txtNotes = "" & rsEMP("Notes")

ReadPictureData

Me.MousePointer = vbNormal




txtregno = "" & rsEMP("RegNo")
txtlearnearsno = "" & rsEMP("learnersno")


End With
End If

End Sub

Private Sub optclamt_Click()

If optclamt.Value = True Then
txtsrtyamt.Enabled = True
DTPsrchtestdate.Enabled = False


DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False


ElseIf Optname.Value = True Then
txtsrchname.Enabled = True
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Opttestdate.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = True
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False
ElseIf Optlenvaon.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
txtsrtyamt.Enabled = False
DTPlenvalon.Enabled = True
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Optvabt.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = True
DTplernvalto.Enabled = True
End If
End Sub


Private Sub Optlenvaon_Click()
If Optname.Value = True Then
txtsrchname.Enabled = True
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf optclamt.Value = True Then
txtsrtyamt.Enabled = True
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Opttestdate.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = True
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Optlenvaon.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
txtsrtyamt.Enabled = False
DTPlenvalon.Enabled = True
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Optvabt.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = True
DTplernvalto.Enabled = True
End If
End Sub

Private Sub Optname_Click()
If Optname.Value = True Then
txtsrchname.Enabled = True
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Opttestdate.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = True
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Optlenvaon.Value = True Then
txtsrtyamt.Enabled = False
txtsrchname.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = True
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Optvabt.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = True
DTplernvalto.Enabled = True
End If

'ElseIf optclamt.Value = True Then
txtsrtyamt.Enabled = True
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False
End Sub

Private Sub Opttestdate_Click()
If Optname.Value = True Then
txtsrchname.Enabled = True
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False
txtsrtyamt.Enabled = False

ElseIf Opttestdate.Value = True Then
txtsrchname.Enabled = False
DTPsrchtestdate.Enabled = True
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False
txtsrtyamt.Enabled = False

ElseIf Optlenvaon.Value = True Then
txtsrchname.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = True
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False
txtsrtyamt.Enabled = False

ElseIf Optvabt.Value = True Then
txtsrchname.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = True
DTplernvalto.Enabled = True

ElseIf optclamt.Value = True Then
txtsrtyamt.Enabled = True
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False


End If

End Sub

Private Sub Optvabt_Click()
If Optname.Value = True Then
txtsrchname.Enabled = True
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Opttestdate.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = True
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Optlenvaon.Value = True Then
txtsrchname.Enabled = False
txtsrtyamt.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = True
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False

ElseIf Optvabt.Value = True Then
txtsrchname.Enabled = False
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = True
DTplernvalto.Enabled = True
txtsrtyamt.Enabled = False

ElseIf optclamt.Value = True Then
txtsrtyamt.Enabled = True
DTPsrchtestdate.Enabled = False
DTPlenvalon.Enabled = False
DTPlenvalfrom.Enabled = False
DTplernvalto.Enabled = False


End If
End Sub

Private Sub PrintForm_Click()
PrintForm
End Sub

[Dal Jeanis]

There are a number of causes that can throw that error. Usually, it means that there is something wrong with the way an argument has been built or passed to a routine.

When you receive the error, click "debug". What exact line is returning the error? What are the values of each argument of that line?

[bobykuriakose12]

thank you for your information.
i notify the error code on debug-----pictData() = rsEMP("Photo").GetChunk(leftOverData)
i also attached Private Sub ReadPictureData() source code....







Private Sub ReadPictureData()

Dim diskFile As String
diskFile = App.Path & "\temp\emp.bmp"

Dim tempDir As String
tempDir = Dir(App.Path & "\temp", vbDirectory)

If tempDir = "" Then
MkDir App.Path & "\temp"
End If

' Delete the temp picture file.
If Len(Dir$(diskFile)) > 0 Then
Kill diskFile
End If

'Get the Phot size
fileSize = rsEMP("Photo").ActualSize

'Get a free file handle
Dim destfileNum As Long
destfileNum = FreeFile

'Open the file
Open diskFile For Binary As destfileNum

'Calculate the number of blocks (100000 bytes blocks)
Dim pictBlocks As Integer
pictBlocks = fileSize / BLOCK_SIZE

'Calculate the left over data
Dim leftOverData As Long
leftOverData = fileSize Mod BLOCK_SIZE

'Byte array for Picture data.
Dim pictData() As Byte
'Get the left over data first
pictData() = rsEMP("Photo").GetChunk(leftOverData)

'write the binary picture data from a variable to disk file
Put destfileNum, , pictData()

Dim i

'Now get the remaining binary picture data in Blocks of 100000
For i = 1 To pictBlocks
pictData() = rsEMP("Photo").GetChunk(BLOCK_SIZE)
Put destfileNum, , pictData()
Next i

'Close the file handle
Close destfileNum

'Load the temp Picture into the Image control
Image1.Picture = LoadPicture(App.Path & "\temp\emp.bmp")

End Sub

[Dal Jeanis]

The code doesn't make much sense to me, if you intend it to be reading and writing saved data off of the file. For instance, I don't see where you are saving or reading the size of the image that you are going to store or going to read. For instance, if you are going to store a 25000-byte picture, then at a minimum you need to store the number 25000 first, then the 25 10000-byte chunks. Otherwise, your program will never know when it has read the whole thing. Is each image going to get its own separate file?

Here's a couple of relevant references, that you can compare to your own code and make sure you are doing what you need to do .
http://support.microsoft.com/kb/151335
http://webpages.eng.wayne.edu/~af260...ileiohelp.html

[bobykuriakose12]

Dear sir,

i am also attached my project and database as zip file,can you please verify,what is the problem of my form

[bobykuriakose12]

dear sir,


thank you for your information. i saved picture in vb and retrive it.but the problem is happening.if i open any record and add any information,its successfully saved but in database in same name- same record was saved.if i edit 10 times
in a record,so 10 same records are created in database .






regards
boby

[Dal Jeanis]

I do not have Visual Studio, so I may not be able to look at your project to help. The Access file contained only one table, nor forms or modules. My Access (2010) and its VB both refused to import the frm and frx files to Access, so I'm not sure what's going on.

So, I can't see exactly what you see, and I'll have to walk you through the debugging steps that I would use if I had the database here. What I am trying to see, first, is how your forms and data relate to each other.

You said that when you open a record and change anything, it is saved again as a new record. Is that correct? And, just to be clear, do you mean that (A) it is saved as a new duplicate record in the table, or did you mean that (B) the image file is saved as a duplicate file on your computer?

If (A) is true, then please tell me the following information:

What is the name of the main form?
Name : 

On the Data tab of the Properties pane for the main form, what are the values of these properties?
Record Source    : 
Recordset Type   : 
Fetch Defaults   : 
Filter           : 
Filter On Load   : 
Order By         : 
Order By On Load : 
Data Entry       : 
Allow Additions  : 
Allow Deletions  : 
Allow Edits      : 
Allow Filters    :
Record Locks     :

If there is a subform, what is the name of the link control on the main form that links to the subform?
Name  :

On the Data tab of the Properties pane for the link control, what are the values of these properties?
Source Object           : 
Link Master Field       : 
Link Child Field        :
Filter on Empty Master  : 

What is the name of the subform?
Name: 

On the Data tab of the Properties pane for the subform, what are the values of these properties?
Record Source    : 
Recordset Type   : 
Fetch Defaults   : 
Filter           : 
Filter On Load   : 
Order By         : 
Order By On Load : 
Data Entry       : 
Allow Additions  : 
Allow Deletions  : 
Allow Edits      : 
Allow Filters    :
Record Locks     :

If (B) is true, then look in your code that saves the file, and see where you are testing to see whether the file has been changed. If you have no code to test that, then you need to put some in. That means that when you read the file originally, you'll need to set some kind of flag to "unchanged", and when you change the image, you'll have to set that flag to "changed", then when you save the image to disk, set the flag back to "unchanged". (For example - there are lots of ways to track this, including some using the "Dirty" property.)

[bobykuriakose12]

Thank you very much.i appreciate your response.the issue was solved,rs field error happens.


Regards
boby

[Dal Jeanis]

Excellent. If you have gotten what you need, please mark the thread solved. top of page, under "thread tools".