Results 1 to 4 of 4
  1. #1
    Join Date
    May 2006

    Unanswered: "THIS MAY NOT BE POSSIBLE" Help Pleeeze Linking .jpg using code

    Operating System: WinXp Pro
    Access 2000 (9.0.6926 SP-3


    I have a form named “Department Employee” on it is a bound object frame named “Photo”; I am having trouble writing code that will allow me to select a .jpg from a floppy, rename it to the current record number, store it in a directory and link it to my form for viewing. I would like to perform this using a button named “Command342”

    Thanks in advance

    Private Sub Command342_Click()

    Is it possible to write vba code that will perform the this function?

    1. Move a .jpg image from - A:\ (Floppy Drive)
    2. Rename it to the value of textbox1.value
    3. Move it to a directory named Photos at H:\Generald\Images
    4. Link it to a bound object frame named “Photo”
    Form Name: Department Employee
    Table Name: Employee Id
    Object Name: Photo

  2. #2
    Join Date
    Feb 2004
    New Zealand
    Provided Answers: 5
    Find attach a little program I wrote for you

    all you need to do is import the Getpicture (Form) and the Const var (module)

    all the module has is a public const for you to set

    All i did in the form1 there is a buttom ...
    which open the getpicture form and pass the textbox1.value

    so you could copy paste the biit of code in yours

    and for the last bit


    on you form that showing the image

    Private Sub Form_Current()

    if textbox1.value <> "" then
    Me.Photo.Picture = Savefolder & "\" & Me.textbox1.Value
    end if


    if not NewRecord then
    Me.Photo.Picture = Savefolder & "\" & Me.textbox1.Value
    end if

    end sub

    just rem that the Form_Current event only get run when goto next record

    so if you want to update the current form after picking the picture then

    you will have add

    Call Form_Current()

    after the

    DoCmd.OpenForm "GetPicture", acNormal, , , , acDialog, Me.textbox1.Value

    note the acDialog that should stop the form code from running until that form is closed
    longtime ago used acDialog think they are the rules
    Attached Files Attached Files
    Last edited by myle; 10-01-06 at 19:14.
    hope this help

    See clear as mud

    StePhan McKillen
    the aim is store once, not store multiple times
    Remember... Optimize 'til you die!
    Progaming environment:
    Access based on my own environment: DAO3.6/A97/A2000/A2003/A2007/A2010
    VB based on my own environment: vb6 sp5
    ASP based on my own environment: 5.6
    VB-NET based on my own environment started 2007
    SQL-2005 based on my own environment started 2008

  3. #3
    Join Date
    Nov 2003
    Well....Since I'm a little bored at the moment, I'll give this a go.

    To answer your question....Yes it is possible and here is one way you can go about it BUT do reconsider the Image control you are using. Think about linking to the standard Image Control instead and keep your database size to a minimum:

    To begin with, you need to realize that the a OLE Object Frame is designed by default to display only .BMP or .DIB image files. To view .JPG or other image file types, you will need additional software on your computer (or everyones computer that runs the Database) that supports the display of other image types and requires a OLE server to display these other image types. If displaying .BMP or .DIB images then a OLE Server or graphic filter is not required. Kind of a pain if your database is used in a multi user environment. This is why most developers use the standard Image Control rather than a bound or unbound OLE Frame. OLE Frames tend to also bloat a database a great deal so using them is not neccessarily recommended (in my point of view). But anyway....

    Normally, your OLE image server will come from the Microsoft Picture Viewer application or the newer Microsoft Photo Editor application. It all depends upon how up to date you operating system might be or what graphics applications you may have contained within you computer system(s) that contain their own OLE server and have bound this service to that particular application. It's now starting to get somewhat retarded when it comes to displaying an image within a OLE Image Frame....don't you agree. Is it worth it? In my opinion, absolutely not!

    In any case, to get things going, you will need to place some code into the Declarations section of a Database code module so as to prepare for the use of some Windows API functions. In particular, API functions will be used to display a File Browse Dialog window where the user can browse for and select the required employee JPG image file to be placed into any given employee record. These API's cover file browsing in either NT or non-NT type operating systems. We'll also be using a Windows API function for Copying the selected image file to your choice of a specific destination location. In your case this would be the H:\Generald\Images\Photos\ folder. If the specified destination path does not exist it will automatically be created no matter how deeply nested the path may be with yet another Windows API function. Place the following into the Declarations section of a Database code module:

    Public Const PROGRESS_CANCEL = 1
    Public Const PROGRESS_CONTINUE = 0
    Public Const PROGRESS_QUIET = 3
    Public Const PROGRESS_STOP = 2
    Public Const COPY_FILE_FAIL_IF_EXISTS = &H1
    Public Const COPY_FILE_RESTARTABLE = &H2
    Public Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" _
                            (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
                            ByVal lpProgressRoutine As Long, lpData As Any, ByRef pbCancel As Long, _
                            ByVal dwCopyFlags As Long) As Long
    Const MB_DEFBUTTON1 = &H0&
    Const MB_DEFBUTTON2 = &H100&
    Const MB_DEFBUTTON3 = &H200&
    Private Const VER_PLATFORM_WIN32_NT = 2
    Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
    End Type
    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
    Private Declare Function GetFileNameFromBrowseW Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As Long, ByVal nMaxFile As Long, ByVal lpstrInitialDir As Long, ByVal lpstrDefExt As Long, ByVal lpstrFilter As Long, ByVal lpstrTitle As Long) As Long
    Private Declare Function GetFileNameFromBrowseA Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As String, ByVal nMaxFile As Long, ByVal lpstrInitialDir As String, ByVal lpstrDefExt As String, ByVal lpstrFilter As String, ByVal lpstrTitle As String) As Long
    Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
    Now we want to add a number of Public functions we'll need to be using to make everything fire up properly. They should also go into the same Database code module. Simply copy and paste the following into this module:

    Continued in next post....

    Self Taught In ALL Environments.....And It Shows!

  4. #4
    Join Date
    Nov 2003
    Continued from previous post....

    Public Function CopyMoveFile(Source As String, Dest As String, CopyOrMove As Boolean) As Boolean
       Dim ret As Long
       On Error Resume Next
       ret = CopyFileEx(Source, Dest, 0, 0, 0, COPY_FILE_RESTARTABLE)
       If Err <> 0 Then
          CopyMoveFile = False
          MsgBox "Error Copying the file:" & vbCrLf & vbCrLf & Source & _
                 vbCrLf & vbCrLf & "TO" & vbCrLf & vbCrLf & Dest
          Exit Function
       End If
       If CopyOrMove = True Then
          Kill Source
          If Err <> 0 Then
             CopyMoveFile = False
             MsgBox "Error removing the file '" & GetFileNameFromPath(Source) & _
                    "' from '" & GetPathFromPathString(Source) & _
                    "'. However, the file '" & GetFileNameFromPath(Source) & _
                    "' has been copied to the destination '" & _
                    GetPathFromPathString(Dest) & "' as '" & _
                    GetFileNameFromPath(Dest) & "'."
          End If
       End If
       If ret > 0 Then CopyMoveFile = True
    End Function
    Public Function BrowseForFile(Handle As Long, Optional StartLocation As String, Optional DefaultExten As String, _
                                  Optional TheFilter As String, Optional TheTitle As String) As String
        Dim sSave As String
        sSave = Space(255)
        If StartLocation = "" Then StartLocation = "C:\"
        If TheTitle = "" Then TheTitle = "Browse For File..."
        If DefaultExten = "" Then DefaultExten = "txt"
        If TheFilter = "" Then TheFilter = "Text files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
        'If we're on WinNT, call the unicode version of the function
        If IsWinNT Then
            GetFileNameFromBrowseW Handle, StrPtr(sSave), 255, StrPtr(StartLocation), StrPtr(DefaultExten), StrPtr(TheFilter), StrPtr(TheTitle)
        'If we're not on WinNT, call the ANSI version of the function
            GetFileNameFromBrowseA Handle, sSave, 255, StartLocation, DefaultExten, TheFilter, TheTitle
        End If
        ' Return the result.....
        ' ======================
        ' Remove eccess spaces from returned string.
        sSave = Trim(sSave)
        ' Remove any Null characters from the end of string (if any).
        If Right$(sSave, 1) = Chr$(0) Then
           sSave = Left$(sSave, Len(sSave) - 1)
           GoTo Recheck
        End If
        ' Return the path and file name.
        BrowseForFile = sSave
    End Function
    Private Function IsWinNT() As Boolean
        myOS.dwOSVersionInfoSize = Len(myOS)
        GetVersionEx myOS
        IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
    End Function
    Public Function GetFileNameFromPath(PathStrg As String) As String
       GetFileNameFromPath = Dir$(PathStrg)
    End Function
    Public Function GetPathFromPathString(PathStrg As String) As String
       '  Returns the path part of a string (without File Name)
       GetPathFromPathString = Left$(PathStrg, Len(PathStrg) - Len(Dir$(PathStrg)))
    End Function
    Public Function cmdShowFileSize(FileSpec As String) As String
    Dim strOldFile As String
    Dim strOldSize As String
    Dim strMyDir As String
    Dim strMyFile As String
    'Update the following with your directory and file
    'info or use App.Path. This sample does not include
    'error checking.
    strMyDir = GetPathFromPathString(FileSpec)
    strMyFile = GetFileNameFromPath(FileSpec)
    strOldFile = strMyDir & strMyFile
    strOldSize = FileLen(strOldFile)
    cmdShowFileSize = Format(strOldSize, "#,##0")
    End Function
    ' This function will determine if the provided path (including drive)
    ' in the PathStrg string variable actually exists. Returns False if
    ' the path does not exist and True if it does.
    Public Function DoesPathExist(PathStrg As String) As Boolean
        On Error Resume Next
        If Right$(PathStrg, 1) <> "\" Then PathStrg = PathStrg & "\"
        Dim a$
        a$ = Dir(PathStrg, vbDirectory)
        If a$ <> "" And Err = 0 Then DoesPathExist = True
    End Function
    You may find several of these functions usefull for other applications.

    Now in your command button (Command342) OnClick event you can copy and paste this code to make this go:

       ' If there is no Employee ID then get outta here.
       If IsNull(Me.EmployeeID) = True Then
          MsgBox "You can not select a Employee Photo until" & _
          vbCrLf & "the Employee ID has been established.", _
          vbExclamation, "No Established Employee ID"
          Exit Sub
       End If
       ' Declare variables...
       Dim FileFilter As String
       Dim SourceLoc As String
       Dim PathStrg As String
       Dim SelectedFile As String
       Dim Destination As String
       ' Set up the Filter for the File Browse dialog window...
       FileFilter = "jpg files (*.jpg)" + Chr$(0) + "*.jpg" + Chr$(0) '+ _
                    "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
       ' Set the SourceLoc Variable (to drive A in your case)
       SourceLoc = "A:\"
       ' Set the Destination variable (in your case H:\Generald\Images\)
       Destination = "H:\Generald\Images\Photos\" & CStr(Me.textbox1) & ".jpg"
       ' Fire up the File Browse/Select dialog window...
       ' The PathStrg variable will hold the Path and file
       ' name of the selected JPG file.
       PathStrg = BrowseForFile(Me.hWnd, SourceLoc, "jpg", _
                         FileFilter, "Select Employee Photo")
       ' If the Cancel button was selected within the File
       ' Browse dialog window then get outta here.
       If PathStrg = "" Then Exit Sub
       ' Pull out the file name only from the selected Path and
       ' place it into the Selected File variable.
       SelectedFile = GetFileNameFromPath(PathStrg)
       ' Create the Destination Folder if it Does Not exist.
       ' See if the folder exists...
       If DoesPathExist(GetPathFromPathString(Destination)) = False Then
          ' If it doesn't then create the Path.
          If MakeSureDirectoryPathExists(GetPathFromPathString(Destination)) = 0 Then
             ' If there was and error (MakeSureDirectoryPathExists returns 0) then
             ' display there was an error and get outta here.
             MsgBox "Error Creating Path!", vbExclamation, "Path Creation Error"
             Exit Sub
          End If
       End If
       ' Copy the source file and place it into the designated Destination.
       If CopyMoveFile(PathStrg, Destination, False) = True Then
          ' Set up the OLE Frame control to accept the image...
          Me.Photo.OLETypeAllowed = acOLELinked  'acOLEEmbedded
          Me.Photo.SourceDoc = Destination
          Me.Photo.Action = acOLECreateLink  'acOLECreateEmbed
          ' Place the Destination path into the form's PhotPath
          ' field. This field has the Visible property set to False.
          Me.PhotoPath = Destination
       End If
    Supplied is a small sample of all this in action.

    Attached Files Attached Files
    Self Taught In ALL Environments.....And It Shows!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts