What's Wrong?

[stickman373]

This Code Doesn't Save the edit of my db why?

rs.Edit
FieldUpdate
rs.Update

Public Sub FieldUpdate()
rs.Fields("Title") = txtTitle.Text
rs.Fields("Year") = txtYear.Text
rs.Fields("Source") = cboSource.Text
rs.Fields("Genre") = cboGenre.Text
rs.Fields("Size") = txtSize.Text
rs.Fields("Actor") = txtActor.Text
rs.Fields("Director") = txtDirector.Text
rs.Fields("Description") = txtDescription.Text
rs.Fields("OnCD") = chkCD.Caption
rs.Fields("CDLocal") = txtCDLocal.Text
rs.Fields("CDTitle") = txtCDTitle.Text
End Sub

[Acoustic]

I would put the .edit and .update inside the sub routine. With ADO version 2 and above, any change you make to the database (i.e. .addnew, .edit, .update) will not be committed until the update is explicitly make. There's even a .cancelupdate method to abort changes...My guess is that by not updating the recordset while going between subs is causing the problem. Put the .edit and .update in the sub and see if it works

[stickman373]

that didn't change anything. ANy other ideas?

Entire form code:

[vbode]
Dim DB As Database
Dim rs As Recordset
Dim NumRows As Integer
Dim start As Long
Dim off As Long
Dim intTitle As Long
Dim i As Long

Private Sub cmdBack_Click()
If rs.BOF = True Then
rs.MoveFirst
FillFields
Else
rs.MovePrevious
FillFields
End If
End Sub

Private Sub cmdFirst_Click()
rs.MoveFirst
FillFields
End Sub

Private Sub cmdLast_Click()
rs.MoveLast
FillFields
End Sub

Private Sub cmdNext_Click()
If rs.EOF = True Then
rs.MoveLast
FillFields
Else
rs.MoveNext
FillFields
End If
End Sub

Private Sub cmdSearch_Click()
Select Case cboFields.Text
Case "Title"
Set rs = DB.OpenRecordset("SELECT Title FROM Table1 WHERE (Title=""" & txtSearch.Text & """)")
start = rs.AbsolutePosition
off = rs.RecordCount
If Not (rs.EOF Or rs.BOF) Then
i = 0
For intTitle = start To off
MyList.AddItem (rs.Fields("Title"))
rs.MoveNext
On Error Resume Next
i = i + 1
Next intTitle
End If
Case "Genre"
Set rs = DB.OpenRecordset("SELECT Genre,Title FROM Table1 WHERE (Genre=""" & txtSearch.Text & """)")
start = rs.AbsolutePosition
off = rs.RecordCount
If Not (rs.EOF Or rs.BOF) Then
i = 0
For intTitle = start To off
MyList.AddItem (rs.Fields("Title"))
rs.MoveNext
On Error Resume Next
i = i + 1
Next intTitle
End If
Case "Source"
Set rs = DB.OpenRecordset("SELECT Source,Title FROM Table1 WHERE (Source=""" & txtSearch.Text & """)")
start = rs.AbsolutePosition
off = rs.RecordCount
If Not (rs.EOF Or rs.BOF) Then
i = 0
For intTitle = start To off
MyList.AddItem (rs.Fields("Title"))
rs.MoveNext
On Error Resume Next
i = i + 1
Next intTitle
End If
End Select
End Sub



Private Sub Command1_Click()
cd1.Filter = "Image Files (*.bmp,*.gif,*.jpg)|*.bmp;*.gif;*.jpg"
cd1.ShowOpen
txtPicPath.Text = cd1.FileName
Image1.Picture = LoadPicture(cd1.FileName & "")
rs.Edit
rs.Fields("Picture") = txtPicPath.Text
rs.Update
End Sub

Private Sub Form_Load()

Set DB = DAO.OpenDatabase(App.Path & "\My Movie.mdb")
Set rs = DB.OpenRecordset("Table1")
rs.MoveFirst
FillFields
cboSource.AddItem ("")
cboSource.AddItem ("DVD-SMR")
cboSource.AddItem ("DVD-Divx")
cboSource.AddItem ("DVD-VCD")
cboSource.AddItem ("TeleSync-SMR")
cboSource.AddItem ("TeleSync-Divx")
cboSource.AddItem ("TeleSync-VCD")
cboSource.AddItem ("Screener-SMR")
cboSource.AddItem ("Screener-Divx")
cboSource.AddItem ("Screener-VCD")
cboSource.AddItem ("Cam-SMR")
cboSource.AddItem ("Cam-Divx")
cboSource.AddItem ("Cam-VCD")
cboGenre.AddItem ("")
cboGenre.AddItem ("Anime")
cboGenre.AddItem ("Comedy")
cboGenre.AddItem ("Drama")
cboGenre.AddItem ("Family")
cboGenre.AddItem ("Horror")
cboGenre.AddItem ("Musical")
cboGenre.AddItem ("Sci-Fi")
cboGenre.AddItem ("Sports")
cboGenre.AddItem ("War")
cboGenre.AddItem ("Western")
cboFields.AddItem ("Title")
cboFields.AddItem ("Genre")
cboFields.AddItem ("Source")
End Sub

Private Sub mnuAbout_Click()
Load frmAbout
frmAbout.Show
End Sub

Private Sub mnuExit_Click()
End
End Sub

Private Sub mnuGenerate_Click()
rs.MoveFirst

start = rs.AbsolutePosition
off = rs.RecordCount

i = 0
For intTitle = start To off
Text1.Text = Text1.Text & rs.Fields("Title") & vbCrLf
rs.MoveNext
i = i + 1
Next intTitle

cd1.DialogTitle = "Save You Movie List"
cd1.Filter = "Text Files (*.txt)|*.txt"
cd1.ShowSave

Open cd1.FileName For Output As #1
Print #1, Text1.Text
Close #1

answer = MsgBox("Do You Want To Print The List?", vbYesNo)

If answer = vbYes Then
Dim BeginPage, EndPage, NumCopies, Orientation, e
' Set Cancel to True.
cd2.CancelError = True
On Error GoTo ErrHandler
' Display the Print dialog box.
cd2.ShowPrinter
' Get user-selected values from the dialog box.
BeginPage = cd2.FromPage
EndPage = cd2.ToPage
NumCopies = cd2.Copies
Orientation = cd2.Orientation
For e = 1 To NumCopies
' Put code here to send data to your printer.
Printer.Print Text1.Text
Printer.EndDoc
Next
Exit Sub
ErrHandler:

Exit Sub

Else
End If
End Sub

Private Sub mnuGrid_Click()
Load frmGrid
frmGrid.Show
End Sub

Private Sub mnuHelp_Click()
MsgBox ("Come On This Is A Beta! I'm Not Helping You!")
End Sub

Private Sub mnuList_Click()
Call mnuGenerate_Click
End Sub

Private Sub mnuNew_Click()

txtTitle.Text = ""
txtYear.Text = ""
txtActor.Text = ""
txtSize.Text = ""
txtDescription.Text = ""
txtDirector.Text = ""
cboSource.Text = ""
cboGenre.Text = ""
txtCDTitle.Text = ""
txtCDLocal.Text = ""
txtPicPath.Text = ""
chkCD.Value = 0

End Sub

Private Sub MyList_Click()
Set rs = DB.OpenRecordset("SELECT * FROM Table1 WHERE (Title=""" & MyList.List(MyList.ListIndex) & """)")
FillFields
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "New"
rs.AddNew
datMovie.Recordset.AddNew
txtTitle.Text = ""
txtYear.Text = ""
txtActor.Text = ""
txtSize.Text = ""
txtDescription.Text = ""
txtDirector.Text = ""
cboSource.Text = ""
cboGenre.Text = ""
txtCDTitle.Text = ""
txtCDLocal.Text = ""
chkCD.Value = 0
txtPicPath = ""
rs.Update
rs.MoveLast
Case "Delete"
rs.Delete
rs.MoveNext
Case "Grid"
Load frmGrid
frmGrid.Show
Case "Edit"
FieldUpdate
Case "Delete"
rs.Delete
rs.MoveNext
FillFields
Case "Print"
Call mnuGenerate_Click
Case "Grid"
Load frmGrid
frmGrid.Show
Case "Help"
MsgBox ("Come On This Is A Beta! I'm Not Helping You!")
End Select
End Sub

Public Sub FillFields()
txtTitle.Text = rs.Fields("Title") & ""
txtYear.Text = rs.Fields("Year") & ""
cboSource.Text = rs.Fields("Source") & ""
cboGenre.Text = rs.Fields("Genre") & ""
txtSize.Text = rs.Fields("Size") & ""
txtActor.Text = rs.Fields("Actors") & ""
txtDirector.Text = rs.Fields("Director") & ""
txtDescription.Text = rs.Fields("Description") & ""
chkCD.Caption = rs.Fields("OnCD") & ""
txtCDLocal.Text = rs.Fields("CDLocal") & ""
txtCDTitle.Text = rs.Fields("CDTitle") & ""
txtPicPath.Text = rs.Fields("Picture") & ""
Image1.Picture = LoadPicture(rs.Fields("Picture") & "")
End Sub

Public Sub FieldUpdate()
rs.Edit
rs.Fields("Title") = txtTitle.Text
rs.Fields("Year") = txtYear.Text
rs.Fields("Source") = cboSource.Text
rs.Fields("Genre") = cboGenre.Text
rs.Fields("Size") = txtSize.Text
rs.Fields("Actor") = txtActor.Text
rs.Fields("Director") = txtDirector.Text
rs.Fields("Description") = txtDescription.Text
rs.Fields("OnCD") = chkCD.Caption
rs.Fields("CDLocal") = txtCDLocal.Text
rs.Fields("CDTitle") = txtCDTitle.Text
rs.Update
End Sub

[/Highlight]

[stickman373]

anyone else?