Save Image in Ms-Access 2003 and 2007 Using VB6.0

Hi There

 I was my dream to save image in access I tried many website and books but didn’t do that. Then I consider about memo field in access database. Memo data type is use to hold long amount of data in textual or binary format. Memo field become solution of my problem. I hope my work will help you just, do it in my way….

Design window

Controls

• 2 ADODC
• 2 Label
• 1 CommandButton
• 1 CommonDialog
• 1 ComboBox
• 1 Image

Property Setting

Adodc’s Visible=False for both

Image’s Stretch=true

Reference Add

Project Menu>References>Microsoft ActiveX Data Objects 2.6 Library

Adodc Setting

• Right click on Adodc
• Select ADODC Properties
• Use Connection String radio button
• Builds
• Microsoft Jet 4.0 OLEDB Provider (This engines will change for access 2007)
• Next
• Select your database
• Test Connection for make sure connection is work or not if works then Click On
• Click on Record Source Tab
• Select cmdTable from Command type combo box
• Select your table for next combobox
• This these steps for second ADODC control

Make an temporary t.bmp file in your project folder for hold image temporary for show in image control

Form Code

Dim fname As String

Dim con As New ADODB.Connection

Dim flcn As String

Private Sub Combo1_Click()

    Dim rs As New ADODB.Recordset

    rs.Open "select * from stu where id=" & Combo1.Text, con, adOpenStatic, adLockOptimistic

    'Delete temporary bmp file

    If Dir(App.Path & "\t.bmp") <> "" Then

        Kill App.Path & "\t.bmp"

    End If

    fname = rs.Fields(2)

     Open App.Path & "\t.bmp" For Binary Access Write As #1

     Put #1, , fname

     Close #1

     Image1.Picture = LoadPicture(App.Path & "\t.bmp")

End Sub

Private Sub Command1_Click()

    With dg

      .ShowOpen

       Open .FileName For Binary Access Read As #1

        fname = Space(LOF(1))

        Get #1, , fname

        Close #1

        Adodc1.Recordset.AddNew

        Adodc1.Recordset.Fields(1) = .FileTitle

        Adodc1.Recordset.Fields(2) = fname

        Adodc1.Recordset.Update

        MsgBox "saved"

        fill_data

    End With

End Sub

Private Sub Form_Load()

    Adodc1.Refresh

    Adodc2.Refresh

    fill_data

    con.Provider = "Microsoft.JET.OLEDB.4.0;"

    con.Open App.Path & "\bsw.mdb"

End Sub

Private Sub fill_data()

    Adodc2.Refresh

    Adodc2.Recordset.MoveFirst

    Combo1.Clear

    Do While Not Adodc2.Recordset.EOF

        Combo1.AddItem (Adodc2.Recordset.Fields(0))

        Adodc2.Recordset.MoveNext

    Loop

End Sub

Next Example