[RESOLVED] how to add & save pic to access with vb 6

[salsa31]

hello
i did a project in vb 6 with customers
and i cannot figure out how to add & save picture to access.
i search the web but no luck
hope you pro guys can help me
this is the code for the saving customers.
****************************************

Dim NewID As Long
NewID = NextID("ID", "Customers")
CN.Execute "INSERT INTO Customers (ID, FullName, Address, DateBirth, Facebook, Email, Phone, Cellular, HairColour, Oxygen) VALUES (" & _
NewID & ", '" & _
RplS(Txt(1).Text) & "', '" & _
RplS(Txt(2).Text) & "', #" & _
MyDate(PckBirth.Value) & "#, '" & _
RplS(Txt(4).Text) & "', '" & _
RplS(Txt(5).Text) & "', '" & _
RplS(Txt(6).Text) & "', '" & _
RplS(Txt(7).Text) & "', '" & _
RplS(Txt(8).Text) & "', '" & _
CmbOxygen.Text & "')"

Set Itm = LsVw.ListItems.Add(, , Txt(1).Text)
Itm.Tag = NewID
Itm.Bold = True
Itm.SubItems(1) = Txt(2).Text
Itm.SubItems(2) = Format(PckBirth.Value, "dd/mm/yyyy")
Itm.SubItems(3) = Txt(4).Text
Itm.SubItems(4) = Txt(5).Text
Itm.SubItems(5) = Txt(6).Text
Itm.SubItems(6) = Txt(7).Text
Itm.SubItems(7) = Txt(8).Text
Itm.SubItems(8) = CmbOxygen.Text
Itm.EnsureVisible
Itm.Selected = True
StBar.Panels(2) = Format(LsVw.ListItems.Count, "#,###0")

If ChkRepeat.Value Then
ClearDetails
Txt(1).SetFocus
Exit Sub
End If
TmrClose.Enabled = True
*******************************
im using a toolbar for this
tnx in advanced

[Spoo]

Salsa

My suggestion would be to add the filename and full path
as text fields in lieu of trying to add a BMP to a field.

Then, add some code to retrieve the BMP and put it
where you want it on your form.

Spoo

[salsa31]

Salsa

My suggestion would be to add the filename and full path
as text fields in lieu of trying to add a BMP to a field.

Spoo

i tryed

[LaVolpe]

There is an example in the Database FAQs you may want to look at

Note that Spoo's suggestion would mean you wouldn't actually save the image, but the path/filename to the image. This has problems if your database is used on other PCs or someone deletes/renames the image. You do have options depending on your needs

[salsa31]

hello lavolpe
tnx for the example
i somehow mange to enter a pic
but when i edit & update it 2 things happen.

1.all of the cust has the same pic

2.suddenly the pic of the cust disappears
this is the code for save:
*****************************
Dim NewID As Long
NewID = NextID("ID", "Customers")
CN.Execute "INSERT INTO Customers (ID, FullName, Address, DateBirth, Facebook, Email, Phone, Cellular, HairColour, Oxygen, Photo) VALUES (" & _
NewID & ", '" & _
RplS(Txt(1).Text) & "', '" & _
RplS(Txt(2).Text) & "', #" & _
MyDate(PckBirth.Value) & "#, '" & _
RplS(Txt(4).Text) & "', '" & _
RplS(Txt(5).Text) & "', '" & _
RplS(Txt(6).Text) & "', '" & _
RplS(Txt(7).Text) & "', '" & _
RplS(Txt(8).Text) & "', '" & _
CmbOxygen.Text & "', '" & _
CmmDlg.FileName & "')"



Set Itm = LsVw.ListItems.Add(, , Txt(1).Text)
Itm.Tag = NewID
Itm.Bold = True
Itm.SubItems(1) = Txt(2).Text
Itm.SubItems(2) = Format(PckBirth.Value, "dd/mm/yyyy")
Itm.SubItems(3) = Txt(4).Text
Itm.SubItems(4) = Txt(5).Text
Itm.SubItems(5) = Txt(6).Text
Itm.SubItems(6) = Txt(7).Text
Itm.SubItems(7) = Txt(8).Text
Itm.SubItems(8) = CmbOxygen.Text
Itm.EnsureVisible
Itm.Selected = True
StBar.Panels(2) = Format(LsVw.ListItems.Count, "#,###0")

If ChkRepeat.Value Then
ClearDetails
Txt(1).SetFocus
Exit Sub
End If
TmrClose.Enabled = True
this is the code for edit:
***********************
If LsVw.SelectedItem Is Nothing Then Exit Sub
Me.Enabled = False
LsVw.SelectedItem.EnsureVisible
LsVw.SelectedItem.Selected = True
LsVw.Enabled = False
LsVw.BackColor = &H8000000F
FrCust.Caption = LsVw.SelectedItem & ""
BttnPhoto.Caption = ""
ChkRepeat.Enabled = False
TmrOpen.Enabled = True
SubBttns
With LsVw.SelectedItem
Txt(1).Text = .Text
Txt(2).Text = .SubItems(1)
PckBirth.Value = .SubItems(2)
Txt(4).Text = .SubItems(3)
Txt(5).Text = .SubItems(4)
Txt(6).Text = Replace$(.SubItems(5), " - ", "")
Txt(7).Text = Replace$(.SubItems(6), " - ", "")
Txt(8).Text = .SubItems(7)
CmbOxygen.Text = .SubItems(8)
End With
Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
End Sub
and this is the code for update:
************************

CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "', " & _
"Photo= '" & CustPhoto & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

With LsVw.SelectedItem
.Text = Txt(1).Text
.SubItems(1) = Txt(2).Text
.SubItems(2) = Format(PckBirth.Value, "dd/mm/yyyy")
.SubItems(3) = Txt(4).Text
.SubItems(4) = Txt(5).Text
.SubItems(5) = Txt(6).Text
.SubItems(6) = Txt(7).Text
.SubItems(7) = Txt(8).Text
.SubItems(8) = CmbOxygen.Text
.EnsureVisible
.Selected = True
End With
TmrClose.Enabled = True
End Sub
*******************
please tell me what im doing wrong im stuck with this for 3 hours.

[Nightwalker83]

@ salsa31,

Wrapping your code in [highlight="vb"][/highlight] all make it easiler for people too read.

[Doogle]

Two things I can see immediately

1. When inserting a record the Picture is determined from the FileName property of Comon Dialog Control. If a different picture file hasn't been selected by the user then it will have the same picture as the last record inserted.

2. In your update code you set the Picture column to 'CustPhoto' I don't see anywhere where you actually set that variable to a value.

[salsa31]

i did at the begining
Option Explicit
Dim CustPhoto As String

[Doogle]

That is just defining the variable as a string. Where do you actually give it a value ?

eg CustPhoto = <something>

[salsa31]

@ salsa31,

Wrapping your code in [highlight="vb"][/highlight] all make it easiler for people too read.

how do i wrapp?

[salsa31]

That is just defining the variable as a string. Where do you actually give it a value ?

eg CustPhoto = <something>

what do you meen?
the code that i posted is from the project
like i said
it adds the cust picture with no problem but when i
edit the cust and press update and again edit the
pic dissapears.
i dont know what to do
i spen all day with this thing

[Doogle]

If the CustPhoto variable is not set to anything when you perform the Update it will overwrite whatever was there with a null. If you don't want to update the Photo in the Table then remove it from the update, like this:

CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

[salsa31]

If the CustPhoto variable is not set to anything when you perform the Update it will overwrite whatever was there with a null. If you don't want to update the Photo in the Table then remove it from the update, like this:

CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

ok.
but if i want to change the pic then what?
this will not update the photo my friend
i got en error
run time error -2147217900(8004e14)

[Doogle]

If you want to update the photo then leave the code as it was and set CustPhoto to whatever file the user has chosen before you perform the Update.

For example: CustPhoto = CmmDlg.FileName

[salsa31]

If you want to update the photo then leave the code as it was and set CustPhoto to whatever file the user has chosen before you perform the Update.

For example: CustPhoto = CmmDlg.FileName

i did what you say
and when i add a new cust and update i get error

run time error -2147217900(8004e14)
and where do i put this code
"CustPhoto = CmmDlg.FileName"

[Doogle]

'and this is the code for update:
'************************
CustPhoto = cmmDlg.Filename
CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "', " & _
"Photo= '" & CustPhoto & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

[salsa31]

'and this is the code for update:
'************************
CustPhoto = cmmDlg.Filename
CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "', " & _
"Photo= '" & CustPhoto & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

i did this now
but when i press edit and update with adding nothing and again edit
the pic dissapears again lol
and when i press new cust the pic from the last cust is the same

[Doogle]

Perhaps it would be better to set CustPhoto in the edit routine. so it will default to that one if the user doesn't select another one.

Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
CustPhoto = RS!Photo
End Sub
'and this is the code for update:
'************************
If cmmDlg.FileName <> "" Then CustPhoto = cmmDlg.FileName
CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "', " & _
"Photo= '" & CustPhoto & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

If the user hasn't selected a new Photo then the old one will be used.

[salsa31]

Perhaps it would be better to set CustPhoto in the edit routine. so it will default to that one if the user doesn't select another one.

Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
CustPhoto = RS!Photo
End Sub
'and this is the code for update:
'************************
If cmmDlg.FileName <> "" Then CustPhoto = cmmDlg.FileName
CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "', " & _
"Photo= '" & CustPhoto & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

If the user hasn't selected a new Photo then the old one will be used.

where do ii put this code
" Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
CustPhoto = RS!Photo
End Sub"

[Spoo]

Salsa

This is how to "wrap" your code

Type this ...

Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
CustPhoto = RS!Photo
End Sub

... then "select" that code, ie,

1. move your cursor to the beginning
2. hold the Shift key down and use the down arrow to highlight to the end
3. then click the "Code" icon that appears at the top of the editor.

This is the result ...

   Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
   Set BttnPhoto.Picture = LoadPicture(RS!Photo)
   CustPhoto = RS!Photo
End Sub

Two main things happen:

1. the code appears in Courier font and in a grey box to make it "pop out"
2. all leading spaces (ie, indents) are preserved.

I hope that helps you

Spoo

[salsa31]

Salsa

This is how to "wrap" your code

Type this ...

Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
CustPhoto = RS!Photo
End Sub

... then "select" that code, ie,

1. move your cursor to the beginning
2. hold the Shift key down and use the down arrow to highlight to the end
3. then click the "Code" icon that appears at the top of the editor.

This is the result ...

   Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
   Set BttnPhoto.Picture = LoadPicture(RS!Photo)
   CustPhoto = RS!Photo
End Sub

Two main things happen:

1. the code appears in Courier font and in a grey box to make it "pop out"
2. all leading spaces (ie, indents) are preserved.

I hope that helps you

Spoo

i will try that next time
its too bad that i didnt find the problem in my project

[Doogle]

where do ii put this code
" Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
CustPhoto = RS!Photo
End Sub"

As I suggested, the change should go into the edit code.

You've already got the first two startements I just added the CustPhoto = RS!Photo statement to it.
Here's the updated code for edit and update, I've commented the changes I have suggested

'this is the code for edit:
'***********************
If LsVw.SelectedItem Is Nothing Then Exit Sub
Me.Enabled = False
LsVw.SelectedItem.EnsureVisible
LsVw.SelectedItem.Selected = True
LsVw.Enabled = False
LsVw.BackColor = &H8000000F
FrCust.Caption = LsVw.SelectedItem & ""
BttnPhoto.Caption = ""
ChkRepeat.Enabled = False
TmrOpen.Enabled = True
SubBttns
With LsVw.SelectedItem
    Txt(1).Text = .Text
    Txt(2).Text = .SubItems(1)
    PckBirth.Value = .SubItems(2)
    Txt(4).Text = .SubItems(3)
    Txt(5).Text = .SubItems(4)
    Txt(6).Text = Replace$(.SubItems(5), " - ", "")
    Txt(7).Text = Replace$(.SubItems(6), " - ", "")
    Txt(8).Text = .SubItems(7)
    CmbOxygen.Text = .SubItems(8)
End With
Set RS = CN.Execute("SELECT Photo FROM Customers WHERE ID= " & LsVw.SelectedItem.Tag)
Set BttnPhoto.Picture = LoadPicture(RS!Photo)
CustPhoto = RS!Photo            ' Added by Doogle to set the default Photo
End Sub
'and this is the code for update:
'************************
If cmmdlg.FielName <> "" Then CustPhoto = cmddlg.FileName   ' Added by Doogle to set
                                                            ' the Photo to the picture
                                                            ' selected by the user if they
                                                            ' did select one
CN.Execute "UPDATE Customers SET " & _
"FullName= '" & RplS(Txt(1).Text) & "', " & _
"Address= '" & RplS(Txt(2).Text) & "', " & _
"DateBirth= #" & MyDate(PckBirth.Value) & "#, " & _
"Facebook= '" & RplS(Txt(4).Text) & "', " & _
"Email= '" & RplS(Txt(5).Text) & "', " & _
"Phone= '" & RplS(Txt(6).Text) & "', " & _
"Cellular= '" & RplS(Txt(7).Text) & "', " & _
"HairColour= '" & RplS(Txt(8).Text) & "', " & _
"Oxygen= '" & CmbOxygen.Text & "', " & _
"Photo= '" & CustPhoto & "' " & _
"WHERE ID= " & LsVw.SelectedItem.Tag

With LsVw.SelectedItem
    .Text = Txt(1).Text
    .SubItems(1) = Txt(2).Text
    .SubItems(2) = Format(PckBirth.Value, "dd/mm/yyyy")
    .SubItems(3) = Txt(4).Text
    .SubItems(4) = Txt(5).Text
    .SubItems(5) = Txt(6).Text
    .SubItems(6) = Txt(7).Text
    .SubItems(7) = Txt(8).Text
    .SubItems(8) = CmbOxygen.Text
    .EnsureVisible
    .Selected = True
End With
TmrClose.Enabled = True

[salsa31]

thank you Doogle it seems to work perfect!!!!
but only 2 problems
when i press the add new cust button
it shows me the same picture that i added for the previous customer.
****************************************************
Private Sub AddCust()
ClearDetails
Me.Enabled = False
LsVw.Enabled = False
FrCust.Caption = "NEW CUST"
If Not LsVw.SelectedItem Is Nothing Then LsVw.SelectedItem.Selected = False
LsVw.BackColor = &H8000000F
CmbOxygen.Text = 1
TxtFind.Enabled = False
ChkRepeat.Enabled = True
TmrOpen.Enabled = True
FrCust.refresh

SubBttns
End Sub


second problem
when i add the first pic to the the customer
it shows me the same pic on a difrrent customer

[Doogle]

Perhaps you could Zip your Project up and attach it here.

From what I can see, the problem is in the Edit and Update processes.

If you want to Edit the data, the Picture may or may not be changed. How do you determine that in your code ?

eg I want to edit the details and change the Facebook details and Photo. How do I do that?

[salsa31]

i added my project

[salsa31]

Perhaps you could Zip your Project up and attach it here.

From what I can see, the problem is in the Edit and Update processes.

If you want to Edit the data, the Picture may or may not be changed. How do you determine that in your code ?

eg I want to edit the details and change the Facebook details and Photo. How do I do that?

this is the project
http://www.megaupload.com/?d=TP9EV39Z

[Doogle]

That appears to be a .rar archive rather than .zip. Unfortunately I can't open .rar files (which is why I suggested .zip)

[salsa31]

That appears to be a .rar archive rather than .zip. Unfortunately I can't open .rar files (which is why I suggested .zip)

here
http://www.megaupload.com/?d=TOEP592N