Minggu, 05 Maret 2017

[MS_AccessPros] Re: BLOB file in a ACCE (exe accessfile)

 

'This is the  vba code  to convert a blob file to jpg in access 2016

 

Private Sub OmzetFoto() 'sub to change blob to jpg first look for the record

Dim r As DAO.Recordset, sSQL As String, sTempPicture As String  'dimension of used parameters

 ' Me.PersIDInternebegeleider is the combo box with the name of person I want to show

' it is a reference to a field from that record in the sql database

 

If IsNull(Me.PersIDInternebegeleider) Then ' if there is nothing in the combo box end sub

GoTo einde

Else

    sSQL = "SELECT * FROM dbo_persJpg where persid=" & Me.PersIDInternebegeleider.Value ' look for the specific record in the sql database

 

    Set r = CurrentDb.OpenRecordset(sSQL)  'temp recordset

    If Not (r.EOF And r.BOF) Then

        sTempPicture = "D:\Werfbeheer lhma\MyTempPicture.jpg" ' store the picture temporary create folder before use

        Call BlobToFile(sTempPicture, r("jpg")) ' call the conversion function

        If Dir(sTempPicture) <> "" Then ' when there is a file show it

          

         Me.Personeelsfoto.Picture = sTempPicture  'put the photo in a picture field on the form

        

        End If

    End If

    r.Close 'close recordset

    Set r = Nothing ' empty r

End If

einde:

End Sub

 

 

---------------------------------------------------------------------------------------

 

'Function:  BlobToFile - Extracts the data in a binary field to a disk file.

'Parameter: strFile - Full path and filename of the destination file.

'Parameter: Field - The field containing the blob.

'Return:    The length of the data extracted.

 

Public Function BlobToFile(strFile As String, ByRef Field As Object) As Long

    On Error GoTo BlobToFileError

 

    Dim nFileNum As Integer

    Dim abytData() As Byte

    BlobToFile = 0

    nFileNum = FreeFile

    Open strFile For Binary Access Write As nFileNum

    abytData = Field

    Put #nFileNum, , abytData

    BlobToFile = LOF(nFileNum)

 

BlobToFileExit:

    If nFileNum > 0 Then Close nFileNum

    Exit Function

 

BlobToFileError:

    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, _

           "Error writing file in BlobToFile"

    BlobToFile = 0

    Resume BlobToFileExit

 

End Function

 



SCK•CEN Disclaimer: http://www.sckcen.be/en/e-mail_disclaimer

__._,_.___

Posted by: Delnooz Dirk <dirk.delnooz@sckcen.be>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (3)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


.

__,_._,___

Tidak ada komentar:

Posting Komentar