Private Sub LoadPic_DB(ByVal lPicNum As Long)
Dim strFilename As String
Dim rsTemp As adodb.Recordset
Dim strResponse As String
Dim strSQL As String
Dim strTitle As String
Dim adoCmd As adodb.Command
Dim mstream As adodb.Stream
cdMain.ShowOpen
strFilename = cdMain.FileName
strResponse = MsgBox("Are you sure you want to load this picture?", vbInformation + vbYesNo, "LOAD")
If strResponse = vbNo Then
Exit Sub
End If
strTitle = UserPermissions.strUserName & "_" & Format(Now, "yyyymmddhhnnss")
strSQL = "Insert into CARD_PICT ([CARD_PICT_ID]) VALUES ('"
strSQL = strSQL & strTitle & "')"
Set adoCmd = New adodb.Command
With adoCmd
.CommandText = strSQL
.CommandType = adCmdText
.ActiveConnection = strCon
.Execute
End With
Set rsTemp = New adodb.Recordset
rsTemp.Open "CARD_PICT", strCon, adOpenKeyset, adLockPessimistic, adCmdTable
rsTemp.Find "CARD_PICT_ID ='" & strTitle & "'"
rsTemp.Fields("CARD_PICT_TYPE") = Trim(Mid(strFilename, InStr(1, strFilename, ".")))
Set mstream = New adodb.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.LoadFromFile strFilename
rsTemp.Fields("CARD_PICT_IMAG").Value = mstream.Read
rsTemp.Update
'AddNewImage rsTemp, strTitle, strFileName
MsgBox "Picture has been added!", vbInformation, "Success"
Select Case lPicNum
Case 1
strPic1_ID = strTitle
Case 2
strPic2_ID = strTitle
Case 3
strPic3_ID = strTitle
End Select
If rsTemp.State = adStateOpen Then
rsTemp.Close
Set rsTemp = Nothing
End If
End Sub
Private Sub OpenImage(ByVal lPicNum As Long)
Dim rsTemp As adodb.Recordset
Dim mstream As adodb.Stream
Dim strTitle As String
Dim strFilename As String
Dim strType As String
Set rsTemp = New adodb.Recordset
rsTemp.Open "CARD_PICT", strCon, adOpenKeyset, adLockPessimistic, adCmdTable
Select Case lPicNum
Case 1
strTitle = strPic1_ID
Case 2
strTitle = strPic2_ID
Case 3
strTitle = strPic3_ID
End Select
rsTemp.Find "CARD_PICT_ID ='" & strTitle & "'"
strType = rsTemp.Fields("CARD_PICT_TYPE")
Set mstream = New adodb.Stream
mstream.Type = adTypeBinary
mstream.Open
mstream.Write rsTemp.Fields("CARD_PICT_IMAG").Value
strFilename = App.Path & "\PICS\" & strTitle & strType
mstream.SaveToFile strFilename, adSaveCreateOverWrite
Select Case lPicNum
Case 1
img1.Picture = LoadPicture(strFilename)
Case 2
img2.Picture = LoadPicture(strFilename)
Case 3
img3.Picture = LoadPicture(strFilename)
End Select
If rsTemp.State = adStateOpen Then
rsTemp.Close
Set rsTemp = Nothing
End If
End Sub