路径/文件访问错误!

我编的是一个学生信息系统,当管理员对学生的信息修改后,不能添加提示"路径/文件访问错误"但是可以删除学生的记录.

解决方案 »

  1.   

    Private Sub cmdAdd_Click()
       '添加记录
       fraSeek.Enabled = False
       fraBrowse.Enabled = False
       grdScan.Enabled = False
        
       DataEnv.rsStudent.AddNew
       txtBirthday.Text = "1980-01-01"   fraInfo.Enabled = True
       fraBrowse.Enabled = False
       
       cmdAdd.Enabled = False
       cmdEdit.Enabled = False
       cmdDelete.Enabled = False
       cmdUpdate.Enabled = True
       cmdReport.Caption = "取消"
       cmdReport.Enabled = True
       
       mbClose = False                   '不能关闭窗口
    End Sub
      

  2.   

    Option Explicit'标识是否能关闭
    Dim mbClose As Boolean'标识当前要显示的照片的文件
    Dim mstrFileName As String'当DataEnv.rsStudent的当前记录发生变化时，刷新所绑定的控件(用户改变了当前记录)
    Sub RefreshBinding()
        On Error Resume Next
       With DataEnv.rsStudent
          If DataEnv.rssqlSeek.BOF And DataEnv.rssqlSeek.EOF Then
             '如果不存在任何记录，则清空所有的绑定的内容
             txtSerial = ""
             txtName = ""
             txtBirthday = ""
             txtTelephone = ""
             txtAddress = ""
             txtResume = ""
          Else  '否则和相应的字段进行绑定
             txtSerial = .Fields("serial")
             txtName = .Fields("name")
             txtBirthday = .Fields("birthday")
             txtTelephone = .Fields("tel")
             txtAddress = .Fields("address")
             txtResume = .Fields("resume")
             cboSex.Text = .Fields("sex")
             dcbClass.Text = .Fields("class")
          End If
       End With
    End Sub''在DataEnv.rsStudent中查询serial为sSerial的学籍信息
    Sub SeekStudent(sSerial As String)
       If Not (DataEnv.rsStudent.EOF And DataEnv.rsStudent.BOF) Then
          Dim Temp As String
          Temp = "serial = " & "'" & sSerial & "'"
          
          DataEnv.rsStudent.MoveFirst
          DataEnv.rsStudent.Find Temp
          
          '刷新所绑定的控件
          Call RefreshBinding
      End If
    End Sub''当改变记录集时，需要刷新用户导航的网格控件
    Sub RefreshGrid()
        grdScan.DataMember = ""
        grdScan.Refresh
        DataEnv.rssqlSeek.Requery
        grdScan.DataMember = "sqlSeek"
        grdScan.Refresh
        
        '刷新各个绑定控件
        Call grdScan_Change
    End Sub''用以在浏览时，根据当前记录所出的位置不同，来改变个浏览按钮的状态
    Sub ChangeBrowseState()
       With DataEnv.rssqlSeek
          If .State = adStateClosed Then .Open
          '如果没有任何记录，使某些按钮无效；否则则使这些按钮有效
          If .BOF And .EOF Then
             cmdAdd.Enabled = True
             cmdEdit.Enabled = False
             cmdDelete.Enabled = False
             cmdUpdate.Enabled = False
             cmdReport.Enabled = False         fraBrowse.Enabled = False
          Else
             cmdAdd.Enabled = True
             cmdEdit.Enabled = True
             cmdDelete.Enabled = True
             cmdUpdate.Enabled = False
             cmdReport.Enabled = True
             
             fraBrowse.Enabled = True
          End If
          
          ''假如处于记录的头部
          If .BOF Then
              If Not .EOF Then DataEnv.rsStudent.MoveFirst
              cmdPrevious.Enabled = False
              cmdFirst.Enabled = False
          Else
              cmdPrevious.Enabled = True
              cmdFirst.Enabled = True
          End If
          ''假如处于记录的尾部
          If .EOF Then
              If Not .BOF Then DataEnv.rsStudent.MoveLast
              cmdNext.Enabled = False
              cmdLast.Enabled = False
          Else
              cmdNext.Enabled = True
              cmdLast.Enabled = True
          End If
        End With
        
        mstrFileName = ""
    End SubPrivate Sub cboDep_Click()
        Dim rsClass As New ADODB.Recordset
        Dim strSQL
        '根据所选的系的不同，采用不同的SQL语句
        If cboDep.ItemData(cboDep.ListIndex) = 0 Then
            strSQL = "select * from class"
        Else
            strSQL = "select * from class where dept_id=" & cboDep.ItemData(cboDep.ListIndex)
        End If
        
        rsClass.Open strSQL, DataEnv.Con
        
        '将所查到的rsClass中的内容来填充cboClass
        cboClass.Clear
        cboClass.AddItem "全部"
        While Not rsClass.EOF
            cboClass.AddItem rsClass("Name")
            rsClass.MoveNext
        Wend
        cboClass.ListIndex = 0
        
        rsClass.Close
        Set rsClass = Nothing
    End SubPrivate Sub cmdAdd_Click()
       '添加记录
       fraSeek.Enabled = False
       fraBrowse.Enabled = False
       grdScan.Enabled = False
        
       DataEnv.rsStudent.AddNew
       txtBirthday.Text = "1980-01-01"   fraInfo.Enabled = True
       fraBrowse.Enabled = False
       
       cmdAdd.Enabled = False
       cmdEdit.Enabled = False
       cmdDelete.Enabled = False
       cmdUpdate.Enabled = True
       cmdReport.Caption = "取消"
       cmdReport.Enabled = True
       
       mbClose = False                   '不能关闭窗口
    End SubPrivate Sub cmdDelete_Click()
        '如果出错，则显示错误代码
      On Error GoTo errHandler
      
      If MsgBox("要删除记录?", vbYesNo + vbQuestion + vbDefaultButton2, "确认") = vbYes Then
            '通过在DataEnv.Con中执行SQL命令，来删除记录
          DataEnv.Con.Execute "delete from student where serial ='" & txtSerial & "'"
          
          DataEnv.rsStudent.MoveNext
          If DataEnv.rsStudent.EOF Then DataEnv.rsStudent.MoveLast
          '刷新用户导航的网格控件
          Call RefreshGrid
      End If
      
      Exit Sub
      
    errHandler:
      MsgBox Err.Description, vbCritical, "错误"
    End SubPrivate Sub cmdEdit_Click()
        '编辑记录之前，需要设置其他控件的Enabled属性
        fraSeek.Enabled = False
        fraBrowse.Enabled = False
        grdScan.Enabled = False
        
        fraInfo.Enabled = True
          
        cmdAdd.Enabled = False
        cmdEdit.Enabled = False
        cmdDelete.Enabled = False
        cmdUpdate.Enabled = True
          
        cmdReport.Caption = "取消"    ''更改cmdReport标题
        cmdReport.Enabled = True
          
        mbClose = False              '出于编辑状态，则用户不能关闭窗口
    End SubPrivate Sub cmdFirst_Click()
        '移动到记录的头部，并改变各个浏览按钮的状态
        DataEnv.rssqlSeek.MoveFirst
        DataEnv.rssqlSeek.MovePrevious
        Call ChangeBrowseState
    End SubPrivate Sub cmdLast_Click()
        '移动到记录的尾部，并改变各个浏览按钮的状态
        DataEnv.rssqlSeek.MoveLast
        DataEnv.rssqlSeek.MoveNext
        Call ChangeBrowseState
    End Sub
      

  3.   

    Private Sub cmdList_Click()
        '针对所选的班级，列出班级中所有的学籍信息
        
        Dim strSQL
        If cboClass.Text = "全部" Then
            strSQL = " from student order by serial"
        Else
            strSQL = " from student where class='" & cboClass & "' order by serial"
        End If
        
        DataEnv.rsStudent.Close
        DataEnv.rsStudent.Open "select * " & strSQL
        
        DataEnv.rssqlSeek.Close
        DataEnv.rssqlSeek.Open "select serial, name " & strSQL
        
        
        '刷新用户导航的网格控件，并且根据记录集中记录的数目，来改变各个浏览按钮的状态。
        Call RefreshGrid
        Call ChangeBrowseState
        
        Call grdScan_Change
    End SubPrivate Sub cmdNext_Click()     '移动到记录的下一条
        DataEnv.rssqlSeek.MoveNext
        Call ChangeBrowseState
    End SubPrivate Sub cmdPrevious_Click() '移动到记录的上一条
        DataEnv.rssqlSeek.MovePrevious
        Call ChangeBrowseState
    End SubPrivate Sub cmdReport_Click()
       On Error Resume Next
       If cmdReport.Caption = "取消" Then
          '取消所使用的更新更新
          DataEnv.rsStudent.CancelUpdate
          
          '重新显示原来数据集中的内容
          If DataEnv.rsStudent.BOF Then
             DataEnv.rsStudent.MoveFirst
          Else
             DataEnv.rsStudent.MovePrevious
             DataEnv.rsStudent.MoveNext
          End If
          Call RefreshBinding
          Call ChangeBrowseState
          
          fraSeek.Enabled = True
          fraBrowse.Enabled = True
          fraInfo.Enabled = False
          grdScan.Enabled = True
          cmdReport.Caption = "报表(R)"      mbClose = True
       Else
        '生成报表
          Dim strSQL As String
          DataEnv.rsrptStudent.Close
          strSQL = "select * from student where serial = '" & txtSerial.Text & "'"
          DataEnv.rsrptStudent.Open strSQL
          
          rptStudent.Show
       End If
    End SubPrivate Sub cmdSeek_Click()
       With frmFind
          Dim i As Integer
          '显示查找窗口
          Load frmFind
          
          '填充查找窗体的字段列表框
          .lstFields.Clear
          For i = 0 To DataEnv.rsStudent.Fields.Count - 1
            .lstFields.AddItem (DataEnv.rsStudent(i).Name)
          Next i
          .lstFields.ListIndex = 0
          .Show 1
          
          If .mbFindFailed Then Exit Sub
          
          Dim sTemp As String
          If LCase(.msFindOp) = "like" Then
              sTemp = .msFindField & " " & .msFindOp & " '%" & .msFindExpr & "%'"
          Else
              sTemp = .msFindField & " " & .msFindOp & " '" & .msFindExpr & "'"
          End If
          sTemp = "select * from student where " & sTemp & " order by serial"
          
          Unload frmFind
       End With
        
       '查找数据，并刷新用以导航的网格控件
        DataEnv.rssqlSeek.Close
        DataEnv.rssqlSeek.Open sTemp
        Call RefreshGrid
                
        Exit Sub
        
    errHandler:
        MsgBox "没有符合条件的纪录！", vbExclamation, "确认"
    End SubPrivate Sub cmdSelectPhoto_Click()
        On Error GoTo errHandler:
        
        
        
        
        
      

  4.   


        Exit Sub
        
    errHandler:
        MsgBox Err.Description, vbCritical, "错误"
    End SubPrivate Sub cmdUpdate_Click()
        '更新所添加或者修改的记录
       On Error GoTo errHandler:
       
       Dim str As String
       str = txtSerial.Text
       
       With DataEnv.rsStudent
          .Fields("Serial") = txtSerial.Text
          .Fields("name") = txtName.Text
          .Fields("sex") = cboSex.Text
          .Fields("class") = dcbClass.Text
          .Fields("birthday") = txtBirthday.Text
          .Fields("tel") = txtTelephone.Text
          .Fields("address") = txtAddress.Text
          .Fields("resume") = txtResume.Text
          
          Call WriteImage(.Fields("photo"), mstrFileName)
          .Update
       End With
       
       cmdReport.Caption = "报表(&R)"
       cmdUpdate.Enabled = False
       fraInfo.Enabled = False
       mbClose = True
       
       If DataEnv.rssqlSeek.State = adStateClosed Then DataEnv.rssqlSeek.Open
       '刷新右端用以导航的网格控件
       Call RefreshGrid
       '根据记录集中记录的个数，改变各个按钮的状态
       Call ChangeBrowseState
       
       '定位到刚刚添加或者修改过的记录
       DataEnv.rssqlSeek.MoveFirst
       DataEnv.rssqlSeek.Find "serial='" & str & "'"
       
       fraSeek.Enabled = True
       fraBrowse.Enabled = True
       grdScan.Enabled = True
       Exit Sub
      
    errHandler:
      MsgBox Err.Description, vbCritical, " 错误"
    End SubPrivate Sub dcbClass_Click(Area As Integer)
      If txtSerial = "" Then
         txtSerial = dcbClass.Text
      End If
    End SubPrivate Sub Form_Load()
       On Error Resume Next
       
       Dim rsDep As New ADODB.Recordset, rsClass As New ADODB.Recordset
       Set rsDep = DataEnv.rsDepartment
       Set rsClass = DataEnv.rsClass
       
       '从Department表中读取数据，填充cboDep复合框到中
       rsDep.Open
       cboDep.Clear
       cboDep.AddItem "全部"
       '将各个系的id号作为ItemData附加到复合框中
       cboDep.ItemData(0) = 0
       While Not rsDep.EOF
           cboDep.AddItem rsDep("Name")
           cboDep.ItemData(cboDep.ListCount - 1) = rsDep("id")
           rsDep.MoveNext
       Wend
       cboDep.ListIndex = 0
       
       ''从class表中读取数据，填充到cboClass复合框中
       cboClass.Clear
       cboClass.AddItem "全部"
       While Not rsClass.EOF
           cboClass.AddItem rsClass("Name")
           rsClass.MoveNext
       Wend
       cboClass.ListIndex = 0
       
       cmdList.Value = True
          
       fraManage.Enabled = True
       fraBrowse.Enabled = True
       fraSeek.Enabled = True
       grdScan.Enabled = True
       
       mbClose = True
       
       Call grdScan_Change
    End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
      If Not mbClose Then
        MsgBox "数据正被修改，窗口不能关闭", vbCritical, "错误"
        Cancel = True
      End If
    End SubPrivate Sub grdScan_Change()
       If grdScan.ApproxCount > 0 Then
          Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Book))
       End If
    End SubPrivate Sub grdScan_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
       '当前行改变，则动态改变所要显示的记录
       If LastRow <> grdScan.Book Then
          If grdScan.ApproxCount > 0 Then
             Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Book))
          End If
       End If
    End SubPrivate Sub WriteImage(ByRef Fld As ADODB.Field, DiskFile As String)
        Dim byteData() As Byte '定义数据块数组
        Dim NumBlocks As Long '定义数据块个数
        Dim FileLength As Long '标识文件长度
        Dim LeftOver As Long '定义剩余字节长度
        Dim SourceFile As Long '定义自由文件号
        Dim i As Long '定义循环变量
        
        Const BLOCKSIZE = 4096 '每次读写块的大小
        
        SourceFile = FreeFile '提供一个尚未使用的文件号
        Open DiskFile For Binary Access Read As SourceFile '打开文件
        FileLength = LOF(SourceFile) '得到文件长度
        If FileLength = 0 Then '判断文件是否存在
            Close SourceFile
            MsgBox DiskFile & "无 内 容 或 不 存 在 !"
        Else
            NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
            LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
            Fld.Value = Null
            ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
            For i = 1 To NumBlocks
                Get SourceFile, , byteData() ' 读到内存块中
                Fld.AppendChunk byteData() '写入FLD
            Next i
            
            ReDim byteData(LeftOver) '重新定义数据块的大小
            Get SourceFile, , byteData() '读到内存块中
            Fld.AppendChunk byteData() '写入FLD
            Close SourceFile '关闭源文件
        End If
    End SubPrivate Function ReadImage(blobColumn As ADODB.Field) As String
        '取得一个临时性文件
        Dim strFileName As String
        strFileName = "ImageTmp"    Dim FileNumber      As Integer      '文件号
        Dim DataLen             As Long         '文件长度
        Dim Chunks              As Long         '数据块数
        Dim ChunkAry()      As Byte         '数据块数组
        Dim ChunkSize       As Long         '数据块大小
        Dim Fragment        As Long         '零碎数据大小
        Dim lngI                As Long '计数器
        
        On Error GoTo errHander
        
        ChunkSize = 2048                    '定义块大小为 2K
        If IsNull(blobColumn) Then Exit Function    DataLen = blobColumn.ActualSize         '获得图像大小
        If DataLen < 8 Then Exit Function   '图像大小小于8字节时认为不是图像信息
            FileNumber = FreeFile               '产生随机的文件号
        Open strFileName For Binary Access Write As FileNumber     '打开存放图像数据文件
        Chunks = DataLen \ ChunkSize        '数据块数
        Fragment = DataLen Mod ChunkSize    '零碎数据
        If Fragment > 0 Then            '有零碎数据，则先读该数据
                ReDim ChunkAry(Fragment - 1)
                ChunkAry = blobColumn.GetChunk(Fragment)
                Put FileNumber, , ChunkAry      '写入文件
        End If    ReDim ChunkAry(ChunkSize - 1)             '为数据块重新开辟空间
        For lngI = 1 To Chunks                              '循环读出所有块
                ChunkAry = blobColumn.GetChunk(ChunkSize)   '在数据库中连续读数据块
                Put FileNumber, , ChunkAry()    '将数据块写入文件中
        Next lngI
        Close FileNumber            '关闭文件
        
        ReadImage = strFileName
        
        Exit Function
        
    errHander:
        ReadImage = ""
    End Function