Solved

Picture Object

Posted on 2006-11-06
24
628 Views
Last Modified: 2009-07-29
Hi:
I follow that link and try to save picture into table. There is no error in the form accept it not save the picture into
the table. In the form there is one text box name PictureLocation, one image control name location and one button name
cmdBrowse. Code in the form is as follows:

Private Sub cmdBrowse_Click()
On Error GoTo err_cmdBrowse

    Me![PictureLocation] = GetOpenFile_CLT("C:\", "Select the Logo File")
    Me![PictureLocation] = LCase(Me![PictureLocation])
    Me!Picture.Picture = Me!PictureLocation

exit_cmdBrowse:
    Exit Sub
   
err_cmdBrowse:
    MsgBox Error$
    Resume exit_cmdBrowse
End Sub

Private Sub Form_Current()
If Not Me!PictureLocation = "" Or Not IsNull(Me!PictureLocation) Then
    Me!Picture.Picture = Me!PictureLocation
Else
    Me!Picture.Picture = ""
End If
End Sub

Private Sub Form_Open(Cancel As Integer)
    If IsNull(Me!PictureLocation) Or Me!PictureLocation = "" Then
        ' do nothing
    Else
        Me!Picture.Picture = Me!PictureLocation
    End If
End Sub


Copy from:
http://www.experts-exchange.com/Databases/MS_Access/Q_21254693.html

Module Name:modOpenFile
-----------------------
Option Compare Database

Option Explicit

' Declarations for Windows Common Dialogs procedures
Private Type CLTAPI_OPENFILE
  StrFilter As String             ' Filter string
  intFilterIndex As Long          ' Initial Filter to display.
  strInitialDir As String         ' Initial directory for the dialog to open in.
  strInitialFile As String        ' Initial file name to populate the dialog with.
  strDialogTitle As String        ' Dialog title
  strDefaultExtension As String   ' Default extension to append to file if user didn't specify one.
  lngFlags As Long                ' Flags (see constant list) to be used.
  strFullPathReturned As String   ' Full path of file picked.
  strFileNameReturned As String   ' File name of file picked.
  intFileOffset As Integer        ' Offset in full path (strFullPathReturned) where the file name (strFileNameReturned)

begins.
  intFileExtension As Integer     ' Offset in full path (strFullPathReturned) where the file extension begins.
End Type

Const ALLFILES = "All Files"

Private Type CLTAPI_WINOPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Declare Function CLTAPI_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
  (pOpenfilename As CLTAPI_WINOPENFILENAME) _
As Boolean

Declare Function CLTAPI_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
  (pOpenfilename As CLTAPI_WINOPENFILENAME) _
As Boolean

Declare Sub CLTAPI_ChooseColor Lib "msaccess.exe" Alias "#53" _
  (ByVal hwnd As Long, rgb As Long)

Function GetOpenFile_CLT(strInitialDir As String, strTitle As String) As String
  ' Comments  : Simple file open routine. For additional options, use GetFileOpenEX_CLT()
  ' Parameters: strInitialDir - path for the initial directory, or blank for the current directory
  '             strTitle - title for the dialog
  ' Returns   : string path, name and extension of the file selected
  '
  Dim fOK As Boolean
  Dim typWinOpen As CLTAPI_WINOPENFILENAME
  Dim typOpenFile As CLTAPI_OPENFILE
  Dim StrFilter As String

  On Error GoTo PROC_ERR

  ' Set defaults for the structure
  StrFilter = CreateFilterString_CLT("All Files (*.*)", "*.*", "Database Files (*.MDB)", "*.MDB")

  If strInitialDir <> "" Then
    typOpenFile.strInitialDir = strInitialDir
  Else
    typOpenFile.strInitialDir = CurDir()
  End If

  If strTitle <> "" Then
    typOpenFile.strDialogTitle = strTitle
  End If

  typOpenFile.StrFilter = StrFilter
  typOpenFile.lngFlags = OFN_HIDEREADONLY Or OFN_SHOWHELP

  ' Convert the CLT structure to a Win structure
  ConvertCLT2Win typOpenFile, typWinOpen

  ' Call the Common dialog
  fOK = CLTAPI_GetOpenFileName(typWinOpen)

  ' Convert the Win structure back to a CLT structure
  ConvertWin2CLT typWinOpen, typOpenFile

  GetOpenFile_CLT = typOpenFile.strFullPathReturned

PROC_EXIT:
  Exit Function

PROC_ERR:
  GetOpenFile_CLT = ""
  Resume PROC_EXIT

End Function

Sub ConvertCLT2Win(CLT_Struct As CLTAPI_OPENFILE, Win_Struct As CLTAPI_WINOPENFILENAME)
  ' Comments  : Converts the passed CLTAPI structure to a Windows structure
  ' Parameters: CLT_Struct - record of type CLTAPI_OPENFILE
  '             Win_Struct - record of type CLTAPI_WINOPENFILENAME
  ' Returns   : Nothing
  '
  Dim strFile As String * 512

  On Error GoTo PROC_ERR
 
  Win_Struct.hWndOwner = Application.hWndAccessApp
  Win_Struct.hInstance = 0

  If CLT_Struct.StrFilter = "" Then
    Win_Struct.lpstrFilter = ALLFILES & Chr$(0) & "*.*" & Chr$(0)
  Else
    Win_Struct.lpstrFilter = CLT_Struct.StrFilter
  End If
  Win_Struct.nFilterIndex = CLT_Struct.intFilterIndex

  Win_Struct.lpstrFile = String(512, 0)
  Win_Struct.nMaxFile = 511
 
  Win_Struct.lpstrFileTitle = String$(512, 0)
  Win_Struct.nMaxFileTitle = 511

  Win_Struct.lpstrTitle = CLT_Struct.strDialogTitle
  Win_Struct.lpstrInitialDir = CLT_Struct.strInitialDir
  Win_Struct.lpstrDefExt = CLT_Struct.strDefaultExtension

  Win_Struct.Flags = CLT_Struct.lngFlags

  Win_Struct.lStructSize = Len(Win_Struct)
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  Resume PROC_EXIT
   
End Sub

Sub ConvertWin2CLT(Win_Struct As CLTAPI_WINOPENFILENAME, CLT_Struct As CLTAPI_OPENFILE)
  ' Comments  : Converts the passed CLTAPI structure to a Windows structure
  ' Parameters: Win_Struct - record of type CLTAPI_WINOPENFILENAME
  '             CLT_Struct - record of type CLTAPI_OPENFILE
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
     
  CLT_Struct.strFullPathReturned = Left(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile, vbNullChar) - 1)
  CLT_Struct.strFileNameReturned = RemoveNulls_CLT(Win_Struct.lpstrFileTitle)
  CLT_Struct.intFileOffset = Win_Struct.nFileOffset
  CLT_Struct.intFileExtension = Win_Struct.nFileExtension
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  Resume PROC_EXIT
 
End Sub

Function CreateFilterString_CLT(ParamArray varFilt() As Variant) As String
  ' Comments  : Builds a Windows formatted filter string for "file type"
  ' Parameters: varFilter - parameter array in the format:
  '                          Text, Filter, Text, Filter ...
  '                         Such as:
  '                          "All Files (*.*)", "*.*", "Text Files (*.TXT)", "*.TXT"
  ' Returns   : windows formatted filter string
  '
  Dim StrFilter As String
  Dim intCounter As Integer
  Dim intParamCount As Integer

  On Error GoTo PROC_ERR
 
  ' Get the count of paramaters passed to the function
  intParamCount = UBound(varFilt)
 
  If (intParamCount <> -1) Then
   
    ' Count through each parameter
    For intCounter = 0 To intParamCount
      StrFilter = StrFilter & varFilt(intCounter) & Chr$(0)
    Next
   
    ' Check for an even number of parameters
    If (intParamCount Mod 2) = 0 Then
      StrFilter = StrFilter & "*.*" & Chr$(0)
    End If
   
  End If

  CreateFilterString_CLT = StrFilter

PROC_EXIT:
  Exit Function

PROC_ERR:
  CreateFilterString_CLT = ""
  Resume PROC_EXIT

End Function

Function RemoveNulls_CLT(strIn As String) As String
  ' Comments  : Removes terminator from a string
  ' Parameters: strIn - string to modify
  ' Return    : modified string
  '
  Dim intChr As Integer

  intChr = InStr(strIn, Chr$(0))

  If intChr > 0 Then
    RemoveNulls_CLT = Left$(strIn, intChr - 1)
  Else
    RemoveNulls_CLT = strIn
  End If

End Function

Thanks.
0
Comment
Question by:mustish1
  • 12
  • 7
  • 5
24 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 17881967

is the textbox PictureLocation bound to the field in the table where you want to save the
picture path?
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 17881987
you should set the Control Source of textbox PictureLocation to the field in the table where you want to save the path for the picture.
0
 

Author Comment

by:mustish1
ID: 17882062
I am sorry i didnt bind the textbox. I check in the table one record is created. But when i again try to open the form it gives "Type mismatch" error on line "    If IsNull(Me!PictureLocation) Or Me!PictureLocation = "" Then". In table PictureLoc I create a field name PictureLocation of type OLEObject

Private Sub Form_Open(Cancel As Integer)
    If IsNull(Me!PictureLocation) Or Me!PictureLocation = "" Then
        ' do nothing
    Else
        Me!Picture.Picture = Me!PictureLocation
    End If
End Sub

Thanks.
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 17882148
i would not encourage saving  the picture to the table.
just  make PictureLocation a text type in the table and just save the path to the field PictureLocation.


if you want to store images to your table
you can use the example from this site

http://www26.brinkster.com/alzowze/home.asp

scroll down and download the  
Sample Access 2000 mdb demonstrating populating an image control with Blob data
0
 

Author Comment

by:mustish1
ID: 17882207
Ok I try that.
0
 

Author Comment

by:mustish1
ID: 17882265
Can you please tell me what is blob
Sample Access 2000 mdb demonstrating appending bulk jpegs to a Jet mdb as blobs
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 17882313
BLOB  - Binary Large Object

if you want to learn more of blob , do a search in google.
0
 
LVL 39

Expert Comment

by:stevbe
ID: 17882987
the controls are not finished loading until you get to the Load event of the form so use that instead of Open

Private Sub Form_Load()
    If Len(Me.txtPictureLocation.Value & vbNullString) > 0 Then
        Me.imgPicture.Picture = Me.txtPictureLocation.Value
    End If
End Sub

you8 should also name your controls to be differetn from the fields they are bound to, this will eliminate confusion as to what your code is referring to both for us and for Access itself.
0
 

Author Comment

by:mustish1
ID: 17883147
Now error is "Type mismatch" on that line

If Not Me!txtPictureLocation = "" Or Not IsNull(Me!txtPictureLocation) Then

Private Sub Form_Current()
If Not Me!txtPictureLocation = "" Or Not IsNull(Me!txtPictureLocation) Then
    Me!imgPicture.Picture = Me!txtPictureLocation
Else
    Me!imgPicture.Picture = ""
End If
End Sub
0
 
LVL 39

Expert Comment

by:stevbe
ID: 17883258

Private Sub Form_Current()
    If Len(Me.txtPictureLocation.Value & vbNullString) > 0 Then
        Me.imgPicture.Picture = Me.txtPictureLocation.Value
    Else
        Me!imgPicture.Picture = ""
    End If
End Sub
0
 

Author Comment

by:mustish1
ID: 17883403
There are three records in the table. But the navigation button dont shows the old records.
0
 
LVL 39

Expert Comment

by:stevbe
ID: 17883433
it only says record 1 of 1 instead of 1 of 3?
0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 

Author Comment

by:mustish1
ID: 17883534
yes 1 of 1 instead of  1 of 3.

Thanks.
0
 
LVL 39

Expert Comment

by:stevbe
ID: 17883577
I don't think this issue has anything to do with the picture code.

Do you have a filter set on the form?
Did you change the query so it only returns 1 record?
Are you using the standard navigation button?

Steve
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 17883663
if you are using your own naviagation buttons

me.recordset.movelast   'to get the correct count of records
0
 

Author Comment

by:mustish1
ID: 17883668
Do you have a filter set on the form?  No
Did you change the query so it only returns 1 record? No
Are you using the standard navigation button? Yes
0
 

Author Comment

by:mustish1
ID: 17883696
Settings in form
Record Selectors: yes
Navigatin Button: Yes
Allow filters: No
Allow edits: yes
Allow deletion: yes
Allow Addition: yes
Data Entry: yes

It shows record 1 of 1 not showing the old records
0
 
LVL 39

Expert Comment

by:stevbe
ID: 17883704
Data Entry: yes

should be No.
0
 

Author Comment

by:mustish1
ID: 17883739
I change to data entry No now the error is on the start of the form "Type mismatch"
    If IsNull(Me!txtPictureLocation) Or Me!txtPictureLocation = "" Then


Private Sub Form_Open(Cancel As Integer)
    If IsNull(Me!txtPictureLocation) Or Me!txtPictureLocation = "" Then
        ' do nothing
    Else
        Me!imgPicture.Picture = Me!txtPictureLocation
    End If
End Sub
0
 

Author Comment

by:mustish1
ID: 17889116
I try to upload my database on ee-stuff but it gives error. I create an account on yahoo name
accesserror72
pwd: troy72

If any one please look into my databsae.

Thank You.
0
 
LVL 39

Accepted Solution

by:
stevbe earned 500 total points
ID: 17889332
The controls are not finished loading until you get to the Load event of the form so use Load instead of Open.
You can test for both Null and zero length string (also captures Empty) by checking the Len of the control's Value property ... and there is no need to have a 'do nothing execution path.

Private Sub Form_Load
    If Len(Me.txtPictureLocation.Value & vbNullString) > 0 Then
        Me.imgPicture.Picture = Me.txtPictureLocation.Value
    End If
End Sub
0
 

Author Comment

by:mustish1
ID: 17889414
Now it goes to Form_Current
If Not Me!txtPictureLocation = "" Or Not IsNull(Me!txtPictureLocation) Then

should i change this line with that
     If Len(Me.txtPictureLocation.Value & vbNullString) > 0 Then


Private Sub Form_Current()
If Not Me!txtPictureLocation = "" Or Not IsNull(Me!txtPictureLocation) Then
    Me!imgPicture.Picture = Me!txtPictureLocation
Else
    Me!imgPicture.Picture = ""
End If
End Sub
0
 

Author Comment

by:mustish1
ID: 17889418
Same error:
Type mismatch
0
 
LVL 39

Expert Comment

by:stevbe
ID: 17889623
I posted the code you should use in my first 2 posts but you didn't use it and now you want to know why your old code does not work ???

Private Sub Form_Current()
    If Len(Me.txtPictureLocation.Value & vbNullString) > 0 Then
        Me.imgPicture.Picture = Me.txtPictureLocation.Value
    Else
        Me!imgPicture.Picture = ""
    End If
End Sub
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Combobox issue 4 27
Input box criteria 3 20
MS Access Bound Objects. 6 28
putting an icon in a form 13 21
The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now