Monday, 30 September 2013

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