Vb-access runtime error 3001

B

bobykuriakose12

New Member
Joined
Jun 7, 2013
Messages
2
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
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
New and Seeking VBA Help
Replies
2
Views
724
TheOpportunist
T
P
  • Question
VBA lost Access to IE and stopped working? Runtime 438 Error
Replies
2
Views
891
Photomofo
P
I
  • Question
Custom Printing Function from the Printing Icon
Replies
1
Views
764
IAIPICI
I

Forum statistics

Threads
1,215,884
Messages
6,127,562
Members
449,385
Latest member
KMGLarson

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top