vb做的系统
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 Sub
Private Sub dcbClass_Click(Area As Integer)
If txtSerial = "" Then
txtSerial = dcbClass.Text
End If
End Sub
Private 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 Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not mbClose Then
MsgBox "数据正被修改,窗口不能关闭", vbCritical, "错误"
Cancel = True
End If
End Sub
Private Sub grdScan_Change()
If grdScan.ApproxCount > 0 Then
Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))
End If
End Sub
Private Sub grdScan_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
'当前行改变,则动态改变所要显示的记录
If LastRow <> grdScan.Bookmark Then
If grdScan.ApproxCount > 0 Then
Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))
End If
End If
End Sub
Private 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
调试时“路径/文件访问错误”
高手帮帮我这个菜鸟
[解决办法]
错误出现在哪行 我们也不是超人 看不懂这些是什么
[解决办法]
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 Sub
Private Sub dcbClass_Click(Area As Integer)
If txtSerial = "" Then
txtSerial = dcbClass.Text
End If
End Sub
Private 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 Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not mbClose Then
MsgBox "数据正被修改,窗口不能关闭", vbCritical, "错误"
Cancel = True
End If
End Sub
Private Sub grdScan_Change()
If grdScan.ApproxCount > 0 Then
Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))
End If
End Sub
Private Sub grdScan_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
'当前行改变,则动态改变所要显示的记录
If LastRow <> grdScan.Bookmark Then
If grdScan.ApproxCount > 0 Then
Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark))
End If
End If
End Sub
Private 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