|
- Private Sub CommandButton2_Click() '查询相片
- '引用Microsoft ActiveX Data Objects 2.x Library
- If TextBox1.Text = "" Then Exit Sub
- Dim cnn As New ADODB.Connection
- Dim rs As New ADODB.Recordset
- ' On Error GoTo ErrMsg
- cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\档案.mdb"
- Set srm = New ADODB.Stream
- srm.Mode = adModeReadWrite
- srm.Type = adTypeBinary
- srm.Open
- SQL = "select * from 档案 where 编号='" & TextBox1.Text & "'"
- rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
- If rs.RecordCount Then
- srm.Write (rs.Fields("相片").Value)
- srm.SaveToFile ThisWorkbook.Path & "" & "1.jpg", adSaveCreateOverWrite
- Image2.Picture = LoadPicture(ThisWorkbook.Path & "" & "1.jpg")
- Image2.PictureSizeMode = 1
- End If
- rs.Close
- Set rs = Nothing
- Set srm = Nothing
- cnn.Close
- Set cnn = Nothing
- Exit Sub
- ErrMsg:
- MsgBox Err.Description, , "错误报告"
- End Sub
- Private Sub UserForm_Terminate() '退出窗体时删除临时图片
- On Error Resume Next
- Kill ThisWorkbook.Path & "\1.jpg"
- End Sub
复制代码 |
|