為什麼不能rs.update

leoyan76

我用的是ado,原來在access本身數據庫中可以update，後來把數據庫導入sqlserver2000後就不能保存了，why?百思不得其解。

tz-chf

设主键
(回贴还得凑够十个字)

leoyan76

已設主鍵。代碼如下

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

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

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

andymark

没看到打开记录集的语句rs.open ........................

leoyan76

rs已在form_load時打開，rs.addnew加上也不行。

andymark

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

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

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

leoyan76

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

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

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

leoyan76

錯誤提示是  ODBC失敗。
多謝各位！