vb做的系统

Question

Private 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("class") = dcbClass.Text
       .Fields("sex") = cboSex.Text
      .Fields("birthday") = txtBirthday.Text
      .Fields("address") = txtAddress.Text
      .Fields("tel") = txtTelephone.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 Sub
调试时“路径/文件访问错误”
高手帮帮我这个菜鸟

Answer 1

Private 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("class") = dcbClass.Text
  .Fields("sex") = cboSex.Text
  .Fields("birthday") = txtBirthday.Text
  .Fields("address") = txtAddress.Text
  .Fields("tel") = txtTelephone.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