Office中国论坛/Access中国论坛

标题: 為什麼不能rs.update [打印本页]

作者: leoyan76 时间: 2007-9-27 11:13
标题: 為什麼不能rs.update
我用的是ado,原來在access本身數據庫中可以update，後來把數據庫導入sqlserver2000後就不能保存了，why?百思不得其解。

作者: tz-chf 时间: 2007-9-27 11:15
设主键
(回贴还得凑够十个字)

作者: leoyan76 时间: 2007-9-27 11:19
已設主鍵。代碼如下

On Error GoTo err_exit
If Me.AllowEdits = False Then
MsgBox "無需再次保存"
Exit Sub
End If


Me.AllowAdditions = False
Me.AllowEdits = False
If IsNull(Me.txtFid) Then
      date2 = "SQ" & Format(Date, "yyyymm")
      id = DMax("[f_id]", "[tblmain]", "[f_id] like '" & date2 & "*'")
      If IsNull(id) Then
         rs!f_id = date2 & "00001"
      Else
         rs("f_id") = date2 & Format(CStr(CInt(Right(id, 3)) + 1), "00000")
      End If
   End If

   rs!place = Me.txtPlace
   rs!Description = Me.txtDes
   rs!app_date = Date
   rs!check_id = "0000"
   rs!emp_id = DLookup("id", "tbluser", "pcname='" & getPcname & "'")



      If Me.msDlg.fileName = "" Then
         PCSIZE = 0
      Else
         PicSize = FileLen(Me.msDlg.fileName)
      End If

      If PicSize > 0 Then
         ReDim picData(PicSize)
         FileNo = FreeFile
         Open Me.msDlg.fileName For Binary As #FileNo
         Get #FileNo, , picData()
         Close #FileNo
         rs!photo.Value = picData
         rs!ext = Right(Me.msDlg.fileName, Len(Me.msDlg.fileName) - InStr(1, Me.msDlg.fileName, ".") + 1)
      End If
      rs.Update
      Erase picData
      FillDataFields




      Exit Sub
err_exit:
MsgBox "系統出錯，請檢查記錄或尋求設計人員幫助!"
Exit Sub

作者: kangking 时间: 2007-9-27 11:57
从代码看,你没有建立记录集(可能代码中省略了),对记录集没有进行定位,即:你没有新增记录,也没有移动到需要修改诉记录上.这时的记录可能是指向EOF或BOF,故不能rs.Update.

没有做过,只从代码判断,见笑见笑!

作者: andymark 时间: 2007-9-27 12:22
没看到打开记录集的语句rs.open ........................

作者: leoyan76 时间: 2007-9-27 13:08
rs已在form_load時打開，rs.addnew加上也不行。

作者: andymark 时间: 2007-9-27 13:27

原帖由 leoyan76 于 2007-9-27 13:08 发表
rs已在form_load時打開，rs.addnew加上也不行。

把完整语句贴出来,或上传例子

[ 本帖最后由 andymark 于 2007-9-27 13:28 编辑 ]

作者: leoyan76 时间: 2007-9-27 14:08
Option Compare Database
Dim rs As New ADODB.Recordset
Dim PicName As String, FileNo As Long, picData() As Byte
Dim PicSize As Long

Private Sub cmdAdd_Click()
On Error Resume Next
If Me.AllowAdditions = True Then
      MsgBox "系統正在新增作業中，請保存後再新增記錄"
      Exit Sub
End If

Me.AllowAdditions = True
Me.AllowEdits = True


rs.AddNew
Me.txtFid = ""
Me.txtPlace = ""
Me.txtDes = ""
FillDataFields
End Sub

Private Sub cmdEdit_Click()
Me.AllowEdits = True
End Sub
Private Sub cmdFirst_Click()
If Not rs.BOF Then
      rs.MoveFirst
End If
If Not rs.EOF Then
      FillDataFields
End If
End Sub
Private Sub cmdLast_Click()

If Not rs.EOF Then
      rs.MoveLast
End If
If Not rs.EOF Then
      FillDataFields
End If

End Sub
Private Sub cmdLoadpic_Click()
Me.msDlg.Filter = "picture(*.jpg;*.bmp;*.gif;*.jpeg)|*.jpg;*.bmp;*.gif;*.jpeg|all files(*.*)|*.*"
Me.msDlg.DialogTitle = "請指定欲插入的圖片檔案"
Me.msDlg.Action = 1
If Me.msDlg.fileName = "" Then Exit Sub
imgPic.Picture = Me.msDlg.fileName
End Sub

Private Sub cmdNext_Click()
If Not rs.EOF Then
      rs.MoveNext
End If
If Not rs.EOF Then
      FillDataFields
Else
      rs.MoveLast
End If
End Sub
Private Sub cmdPrevious_Click()
If Not rs.BOF Then
      rs.MovePrevious
End If
If Not rs.BOF Then
      FillDataFields
Else
      rs.MoveFirst
End If
End Sub
Private Sub cmdSave_Click()
On Error GoTo err_exit
If Me.AllowEdits = False Then
MsgBox "無需再次保存"
Exit Sub
End If


Me.AllowAdditions = False
Me.AllowEdits = False
rs.AddNew

If IsNull(Me.txtFid) Then
      date2 = "SQ" & Format(Date, "yyyymm")
      id = DMax("[f_id]", "[tblmain]", "[f_id] like '" & date2 & "*'")
      If IsNull(id) Then
         rs!f_id = date2 & "00001"
      Else
         rs("f_id") = date2 & Format(CStr(CInt(Right(id, 3)) + 1), "00000")
      End If
   End If

   rs!place = Me.txtPlace
   rs!Description = Me.txtDes
   rs!app_date = Date
   rs!check_id = "0000"
   rs!emp_id = DLookup("id", "tbluser", "pcname='" & getPcname & "'")


      If Me.msDlg.fileName = "" Then
         PCSIZE = 0
      Else
         PicSize = FileLen(Me.msDlg.fileName)
      End If

      If PicSize > 0 Then
         ReDim picData(PicSize)
         FileNo = FreeFile
         Open Me.msDlg.fileName For Binary As #FileNo
         Get #FileNo, , picData()
         Close #FileNo
         rs!photo.Value = picData
         rs!ext = Right(Me.msDlg.fileName, Len(Me.msDlg.fileName) - InStr(1, Me.msDlg.fileName, ".") + 1)
      End If
      rs.Update
      Erase picData
      FillDataFields




      Exit Sub
err_exit:
MsgBox "系統出錯，請檢查記錄或尋求設計人員幫助!"
Exit Sub


End Sub

Private Sub cmdSend_Click()
Dim rss As New ADODB.Recordset
Dim idstr As String
Dim fidstr As String
If Me.AllowAdditions = True Or Me.AllowDeletions = True Or Me.AllowEdits = True Then
      MsgBox "您先保存記錄後才能發出郵件"
      Exit Sub
End If
idstr = DLookup("[id]", "tbluser", "pcname like '" & getPcname() & "'")
   rss.Open "select * from tblmain where emp_id like '" & idstr & "' and send = 0", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
   If rss.EOF Then
      MsgBox "無新郵件可需發送"

Else
      fidstr = DLookup("[emp_name]", "tbluser", "pcname like '" & getPcname() & "'") & " 發送的巡檢單" & "，請簽核"
      Call SendMailToFin("brian/deuchem", fidstr)
      MsgBox "巡檢作業單已提出!"

      DoCmd.RunSQL "update tblmain set send=1 where emp_id like '" & idstr & "' and send = 0"

End If

End Sub
Private Sub cmdUndo_Click()
On Error Resume Next
Me.AllowAdditions = False
Me.AllowEdits = False
rs.CancelUpdate
FillDataFields
End Sub
Private Sub Form_Load()
rs.Open "select * from tblmain", CurrentProject.Connection, adOpenKeyset, adLockPessimistic

FillDataFields
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim rss As New ADODB.Recordset
Dim idstr As String
Dim fidstr As String
idstr = DLookup("[id]", "tbluser", "pcname like '" & getPcname() & "'")
   rss.Open "select * from tblmain where emp_id like '" & idstr & "' and send = 0", CurrentProject.Connection, adOpenKeyset, adLockPessimistic
   If Not rss.EOF Then
      If MsgBox("您還有信末發出，是否退出？", vbYesNo) = vbNo Then
         Cancel = True
         Exit Sub
      End If
End If
rss.Close
Set rss = Nothing
rs.Close
Set rs = Nothing
End Sub
Private Function FillDataFields()
On Error Resume Next

      PicName = "c:\" & rs("f_id") & rs("ext")
      If IsNull(rs("photo")) Then PicName = ""

      FileNo = FreeFile
      ReDim FileData(LenB(rs("photo")))
      picData() = rs("photo")
      Open PicName For Binary As #FileNo
      Put #FileNo, , picData()
      Close #FileNo
      Erase FileData

Me.imgPic.Picture = PicName

Kill PicName

txtFid = rs("f_id")
txtPlace = rs("place")
txtDes = rs("description")
txtNum = rs("photo").ActualSize
txtReccnt = rs.RecordCount & " 之 " & rs.AbsolutePosition



End Function

作者: kangking 时间: 2007-9-27 14:42
在你的cmdAdd按钮的单击事件中的rs.AddNew是不需要的,只在保存(cmdSave)时加这一句,因为在你保存前可能还要移动记录,如cmdEdit,cmdNext的单击事件就发生了记录位置的移动.

另外能否将错误的提示贴出来?

作者: leoyan76 时间: 2007-9-27 15:11
錯誤提示是 ODBC失敗。
多謝各位！

作者: andymark 时间: 2007-9-27 16:51
保存的语句有问题,不能分清保存是新增或编辑的保存

新增按钮时是不用addnew的

作者: leoyan76 时间: 2007-9-27 17:13
問題解決，原因是sqlserver資料表中某個字段不充許為空，因此不能保存。

作者: kangking 时间: 2007-9-28 08:51

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)