一个档案管理系统,连接一ACCESS数据库。有一combo控件(combo1),一DTPicker控件(DTP_leave),一Image控件(Image1)，一Command控件（cmd_save）。问题如下：1、当combo1为“在职”时，DTP_leave控件失效。（DTP_leave总是默认记录当前日期）2、如何在Cmd_save_Click事件中保存Image1的照片。
在查询档案时又如何调出已保存好的照片。谢谢！
在查询档案时又如何调出已保存好的照片。谢谢！
Dim rs As New ADODB.Recordset
Dim i As Integer Private Sub Cmd_add_Click()
For i = 0 To 5
Text1(i).Text = ""
Next i
Combo1.Clear
Combo1.AddItem "在职"
Combo1.AddItem "离职"
Combo2.Clear
Combo2.AddItem "中厨"
Combo2.AddItem "点心"
Combo2.AddItem "楼面"
Combo2.AddItem "后勤"
Label_sex.Caption = ""
Label_birthday.Caption = ""Dim constr As String
constr = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\RSDA.Mdb" & " ;Jet OLEDB:Database password=123456"
cn.Open constr
rs.Open "select * from tb_ygxx", cn, adOpenKeyset, adLockPessimistic
If rs.RecordCount = 0 Then
Text1(0).Text = "1"
Text1(1).SetFocus
Cmd_save.Enabled = True
Cmd_add.Enabled = False
End If
If rs.Fields("num") <> "" Then
rs.MoveLast
Text1(0).Text = Format(Val(rs.Fields("num") + 1))
Text1(1).SetFocus
Cmd_save.Enabled = True
Cmd_add.Enabled = False
End If
End SubPrivate Sub Cmd_exit_Click()
Unload Me
Frm_main.Show
End SubPrivate Sub Cmd_save_Click()
If Len(Text1(4)) < 15 Or Len(Text1(4)) > 15 And Len(Text1(4)) < 18 Or Len(Text1(4)) > 18 Then
MsgBox "身份证号码必须为１８位或１５位，请仔细检查！", vbExclamation
End IfDim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\RSDA.Mdb" & " ;Jet OLEDB:Database password=123456"
cnn.Open
rs.Open "Select * from tb_ygxx ", cnn, adOpenKeyset, adLockOptimistic
If Text1(1).Text = "" Or Text1(3).Text = "" Or Text1(4).Text = "" Or Text1(5).Text = "" Or Combo1.Text = "" Or Combo2.Text = "" Then
MsgBox "输入的信息不完整，请仔细检查！", 64, "保存信息提示"
End If
If rs.Fields("IDCard") = Text1(4).Text Then
MsgBox "输入的身份证号码已经存在！", 64, "保存信息提示"
Else
rs.AddNew
rs.Fields("num") = Text1(0).Text
rs.Fields("name") = Text1(1).Text
rs.Fields("sex") = Label_sex.Caption
rs.Fields("birthday") = Label_birthday.Caption
rs.Fields("name2") = Text1(2).Text
rs.Fields("stirps") = Text1(3).Text
rs.Fields("IDCard") = Text1(4).Text
rs.Fields("address") = Text1(5).Text
rs.Fields("join_date") = DTP_join.Value
rs.Fields("status") = Combo1.Text
rs.Fields("department") = Combo2.Text
rs.Fields("leave_date") = DTP_leave.Value
rs.Fields("note") = Text1(6).Text
rs.Update
MsgBox "信息保存成功！", 64, 人事档案管理系统
Cmd_save.Enabled = False
Cmd_add.Enabled = TrueEnd If
End SubPrivate Sub Combo1_LostFocus()
If Combo1.Text = "离职" Then
Label3.Visible = True
DTP_leave.Visible = True
MsgBox "当状况为离职时，必须填写离职日期！"
End If
If Combo1.Text = "在职" Then
Label3.Visible = False
DTP_leave.Visible = FalseEnd If
End SubPrivate Sub Form_Activate()
Combo1.Clear
Combo1.AddItem "在职"
Combo1.AddItem "离职"
Combo2.Clear
Combo2.AddItem "中厨"
Combo2.AddItem "点心"
Combo2.AddItem "楼面"
Combo2.AddItem "后勤"
End SubPrivate Sub Form_Load()
Dim con As New ADODB.Connection
DTP_join.Value = Date
DTP_leave.Value = Date
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\RSDA.Mdb" & " ;Jet OLEDB:Database password=123456"
con.Open
End SubPrivate Sub Image1_Click()
With CommonDialog1
.DialogTitle = "选择要加入的员工相片"
.Filter = "JPG图片|*.JPG"
.ShowOpen
Image1.Picture = LoadPicture(.FileName)
Picture_photo.Picture = LoadPicture(.FileName)
Label_xplj.Caption = .FileName
End With
End Sub
打开vb6,新建工程。添加两个按钮,一个image控件
注意:Access中的photo字段类型为OLE对象.
SqlServer中的photo字段类型为Image'** 引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
‘2.5版本以下不支持Stream对象
Dim iConcstr As String
Dim iConc As ADODB.Connection
'保存文件到数据库中
Sub s_SaveFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConcstr As String '读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile App.Path + "\test.jpg"
End With
'打开保存文件的表
Set iRe = New ADODB.Recordset
With iRe
.Open "select * from img", iConc, 1, 3
.AddNew '新增一条记录
.Fields("photo") = iStm.Read
.Update
End With
'完成后关闭对象
iRe.Close
iStm.Close
End Sub
Sub s_ReadFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
'打开表
Set iRe = New ADODB.Recordset
‘得到最新添加的纪录
iRe.Open "select top 1 * from img order by id desc", iConc, adOpenKeyset, adLockReadOnly
'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("photo")
‘这里注意了,如果当前目录下存在test1.jpg,会报一个文件写入失败的错误.
.SaveToFile App.Path & "\test1.jpg"
End With
Image1.Picture = LoadPicture(App.Path & "\test1.jpg")
'关闭对象
iRe.Close
iStm.Close
End Sub
Private Sub Command1_Click()
Call s_ReadFile
End Sub
Private Sub Command2_Click()
Call s_SaveFile
End Sub
Private Sub Form_Load()
'数据库连接字符串
iConcstr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=F:\csdn_vb\database\保存图片\access图片\img.mdb"‘下面的语句是连接sqlserver数据库的.
‘iConcstr = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
‘ "User ID=sa;Password=;Initial Catalog=test;Data Source=yang"
Set iConc = New ADODB.Connection
iConc.Open iConcstr
End Sub
Private Sub Form_Unload(Cancel As Integer)
iConc.Close
Set iConc = Nothing
End Sub
Label3.Visible = (Combo1.List(Combo1.ListIndex) = "离职")
DTP_leave.Visible = Label3.Visible
End Sub
这段代码好像只是当combo1选择为"离职"时,将label3和DTP_leave设置为不可见。但DTP_leave仍会记录当前日期到数据库中。是否有办法使DTP_leave在数据库中不写入日期。（当Combo1选择为“离职”时）
_____________________________________________if Combo1.Text <> "离职" then
rs.Fields("leave_date") = DTP_leave.Value
end if