VB-ACCESS RUNTIME ERROR 3001



VB-ACCESS RUNTIME ERROR 3001

[pic]

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

................
................

In order to avoid copyright disputes, this page is only a partial summary.

Google Online Preview   Download