Attachment field (1 Viewer)

A

amir369

New member
Local time
Today, 14:24
Joined
Jan 11, 2009
Messages
2
I have a form with an attachment field, which contains several jpg files.
How do I use the control with VBA code for open and display those files
I've tried to use the control's properties but couldn't find the way of using it for my purposes
 
T

tranchemontaigne

Registered User.
Local time
Today, 14:24
Joined
Aug 12, 2008
Messages
203
There are plenty of articles about using MS ACCESS to store and retrieve BLOBS (actually OLEDB Objects).

I've modeled BLOB-type code in MS Access after Leigh Purvis' work successfully. Leigh has posted many valuable tips in these forums

http://www.databasedevelopment.co.uk/examples.htm

I'd have to do some digging, but want you to know that you can use MS Access VBA code to to read the windows registry and establish what application should be used to open an extracted blob file based upon the file extension. This approach provides more portability of the MS Access file across Windows versions.

Is this what you are looking for?
 
T

tranchemontaigne

Registered User.
Local time
Today, 14:24
Joined
Aug 12, 2008
Messages
203
This module and the ones below provide code I wrote to open files based upon file extension. It's the same idea with BLOB files, you would just write the file name to one field in the BLOB table, and store the file in an OLEDB field. The function fnOpenFile would receive the recordset value containing the file name.

Here's the basOpenFile module

Code: 
Option Compare Database
Option Explicit

Private Const gstrObject = "basOpenFile"
Private strError As String

Function fnOpenFile(strFileExtension As String, strFilePath As String) As Boolean
'////////////////////////////////////////////////////////////////////////////////////
'// Author: Tranchemontaigne
'////////////////////////////////////////////////////////////////////////////////////
'// Revision History
'//     Date            Editor          Description
'//     ==========================================================
'//     07 Jan 2009     Tranchemontaigne    -Created
'//     20 Aug 2013     Tranchemontaigne    -Imported into Lyme Letters DB
'//     03 Sep 2013     Tranchemontaigne    -Improved error handling
'//                                     -Split function into a set of function calls
'//                                      to address problem of different people using
'//                                      different versions of Windows and MS Office
'//
'////////////////////////////////////////////////////////////////////////////////////
'// Description
'//     Function opens a file based upon file type association
'//
'////////////////////////////////////////////////////////////////////////////////////
'// Inputs:
'//     Variable            Type    Description
'//     =============================================================================
'//     strFileExtension    String  file extension
'//     strFilePath         String  File name and path
'//
'////////////////////////////////////////////////////////////////////////////////////
'// Requirements:
'//     Visual Basic for Applications
'//     Microsoft ActiveX Data Objects 2.1 Library
'//     Microsoft Access 9.0 Object Library
'//     apicFindExecutable  (basWindowsAPI module)
'//     fnLogError          (basLogError module)
'//
'////////////////////////////////////////////////////////////////////////////////////
On Error GoTo Err_fnOpenFile

Dim strError As String
Dim blFile_Open As Boolean
Dim strPath As String
Dim strLaunch_Path As String
Dim lngPosition As Long

    lngPosition = 999
    strLaunch_Path = ""
            
    lngPosition = InStrRev(strFilePath, "\")
    strPath = Left(strFilePath, lngPosition - 1)
    strLaunch_Path = Trim(apicFindExecutable(strFilePath, strPath))
    strLaunch_Path = Left(strLaunch_Path, Len(strLaunch_Path) - 1)
    strLaunch_Path = Chr(34) & strLaunch_Path & Chr(34) & " " & Chr(34) & Trim(strFilePath) & Chr(34)
            

    Call Shell(strLaunch_Path, vbMaximizedFocus)
    
    fnOpenFile = True


Exit_fnOpenFile:
    Exit Function
    
    
Err_fnOpenFile:
    strError = "strFileExtension: " & strFileExtension & _
                Chr(10) & _
                Chr(13) & _
                "strFilePath: " & strFilePath & _
                Chr(10) & _
                Chr(13) & _
                "lngPosition: " & lngPosition & _
                Chr(10) & _
                Chr(13) & _
                "strLaunch_Path: " & strLaunch_Path & _
                Chr(10) & _
                Chr(13) & _
                "Error: " & Err.Number & ": " & Err.Description
    
    Debug.Print strError
    MsgBox strError, vbCritical, "fnOpenFile encountered an error"
    Call fnLogError(gstrObject, "fnOpenFile", strError)
    
    fnOpenFile = False
    
    Resume Exit_fnOpenFile
    
    
    
End Function
 
Last edited:
T

tranchemontaigne

Registered User.
Local time
Today, 14:24
Joined
Aug 12, 2008
Messages
203
Here's the basWindowsAPI module

Code: 
Option Compare Database
Option Explicit
Private Const gstrObject = "basWindowsAPI"
Private strError As String

Private Declare Function FindExecutable Lib "shell32.dll" Alias _
 "FindExecutableA" (ByVal lpFile As String, ByVallpDirectory As String, _
 ByVal lpResult As String) As Long
 
 
Function fnGet_UserID()
'//////////////////////////////////////////////////////////////////
'// Function: fnGet_UserID
'//////////////////////////////////////////////////////////////////
'// Author: Tranchemontaigne
'//   Created:
'//     7 June 2004
'//   Modified:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     22 Oct 2007     Tranchemontaigne    -Documented function with
'//                                      comments
'//     27 May 2008     Tranchemontaigne    -Edited comments
'//     17 Jul 2013     Tranchemontaigne    -Improved documentation
'//                                     -Added error logging
'//     03 Sep 2013     Tranchemontaigne    -Improved error handling
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     Function makes a Windows system call to identify the
'//     system "UserName" environmental variable
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     fnLogError      (ErrorLog module)
'//
'//////////////////////////////////////////////////////////////////
'// Output:
'//     Returns system "UserName" environmental variable
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnGet_UserID

Dim user_id As String

    user_id = Environ("UserName")
    
    fnGet_UserID = user_id
    
Exit_fnGet_UserID:
    Exit Function
    
Err_fnGet_UserID:
    strError = "fnAccessVersionID encountered an error" & Chr(10) & Chr(13) & _
        "Error: " & Err.Number & ": " & Err.Description
        
    MsgBox strError, vbCritical, gstrObject & " " & "fnAccessVersionID Error"
    Call fnLogError("Windows API", "fnAccessVersionID", strError)

    Resume Exit_fnGet_UserID
    
End Function


Public Function fnAccessVersionID() As String
'//////////////////////////////////////////////////////////////////
'// Function: fnAccessVersionID
'//////////////////////////////////////////////////////////////////
'// Author: RetiredGeek
'//         http://windowssecrets.com/forums/showthread.php/
'//              142262-How-to-find-Access-version-in-code
'//   Created:
'//     08 Nov 2011
'//   Modified:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     03 Sep 2013     Tranchemontaigne    -Modified code
'//                                     -Added documentation
'//                                     -Added error handling
'//                                      comments
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     Function makes a Windows system call to identify the
'//     version of MS Office in use
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     fnLogError      (ErrorLog module)
'//
'//////////////////////////////////////////////////////////////////
'// Output:
'//     Returns system "UserName" environmental variable
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnAccessVersionID

Dim AccessVersionID As Variant

   Select Case SysCmd(acSysCmdAccessVer)
         Case 7: AccessVersionID = "95"
         Case 8: AccessVersionID = "97"
         Case 9: AccessVersionID = "2000"
         Case 10: AccessVersionID = "2002"
         Case 11: AccessVersionID = "2003"
         Case 12: AccessVersionID = "2007"
         Case 13: AccessVersionID = "Pirated!"
         Case 14: AccessVersionID = "2010"
         Case Else: AccessVersionID = "Unknown"
    End Select


    fnAccessVersionID = AccessVersionID


Exit_fnAccessVersionID:
    Exit Function
    
    
Err_fnAccessVersionID:
    strError = "fnAccessVersionID encountered an error" & Chr(10) & Chr(13) & _
        "Error: " & Err.Number & ": " & Err.Description
        
    Debug.Print strError
    
    MsgBox strError, vbCritical, gstrObject & " " & "fnAccessVersionID Error"
    
    Call fnLogError("Windows API", "fnAccessVersionID", strError)
    Resume Exit_fnAccessVersionID
    
    
End Function
 
Last edited:
T

tranchemontaigne

Registered User.
Local time
Today, 14:24
Joined
Aug 12, 2008
Messages
203
Here's the basErrorLog module

Code: 
Option Compare Database
Option Explicit

Private Const gstrObject = "basErrorLog"
Private strError As String

Public Function fnCreate_t99_Error_Log()
'//////////////////////////////////////////////////////////////////
'// Function: fnLog_Error
'//////////////////////////////////////////////////////////////////
'// Author: Tranchemontaigne
'//////////////////////////////////////////////////////////////////
'// Modified:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     21 Jan 2016     Tranchemontaigne   -Created
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     Creates table used by this module
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//
'//////////////////////////////////////////////////////////////////
Dim strSQL As String

    strSQL = "CREATE TABLE"
    strSQL = strSQL & " "
    strSQL = strSQL & "t99_Error_Log"
    strSQL = strSQL & " "
    strSQL = strSQL & "("
    strSQL = strSQL & " "
    strSQL = strSQL & "  t99_Error_ID COUNTER PRIMARY KEY"
    strSQL = strSQL & ", t99_Time     DATETIME"
    strSQL = strSQL & ", t99_Login    TEXT(50)"
    strSQL = strSQL & ", t99_Object   TEXT(50)"
    strSQL = strSQL & ", t99_Code     TEXT(255)"
    strSQL = strSQL & ", t99_Message  MEMO"
    strSQL = strSQL & " "
    strSQL = strSQL & ")"
    
    Call fnRunSQL(strSQL)
    
End Function

Public Function fnLogError(gstrObject As String, gstrCode As String, _
    gstrMessage As String)
'//////////////////////////////////////////////////////////////////
'// Function: fnLogError
'//////////////////////////////////////////////////////////////////
'// Author: Tranchemontaigne
'//////////////////////////////////////////////////////////////////
'// Modified:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     07 Mar 2013     Tranchemontaigne   -Improved documentation
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     If a function, procedure, or subroutine produces an error
'//     record the error in an error log table
'//
'//////////////////////////////////////////////////////////////////
'// Input:
'//     Variable        Description
'//     ===========================================================
'//     gstrObject      Module object producing the error
'//     gstrCode        Code block within module producing error
'//     gstrMessage     Error message
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     fnGet_UserID    (Windows API module)
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnLogError

Dim gstrlogin As String
Dim gdtTime As Date
Dim gstrINSERT As String
Dim gstrVALUES As String
Dim gstrSQL As String

    gstrlogin = ""
    gdtTime = #1/1/1900#
    gstrINSERT = ""
    gstrVALUES = ""
    gstrSQL = ""

    gstrlogin = fnGet_UserID
    gdtTime = Now()
    gstrINSERT = "INSERT INTO t99_Error_Log( [t99_Time], [t99_Login], [t99_Object], [t99_Code], [t99_Message] )"
    gstrVALUES = "VALUES (" & Chr(34) & gdtTime & Chr(34) & ", " & Chr(34) & _
        gstrlogin & Chr(34) & ", " & Chr(34) & gstrObject & Chr(34) & ", " & Chr(34) & _
        gstrCode & Chr(34) & ", " & Chr(34) & gstrMessage & Chr(34) & " );"
    gstrSQL = gstrINSERT & " " & gstrVALUES
    
    With DoCmd
        .SetWarnings False
        .RunSQL gstrSQL
        .SetWarnings True
    End With
    
Exit_fnLogError:
    Exit Function
    
Err_fnLogError:
    strError = "ARGUMENTS: " & Chr(10) & Chr(13) & _
                "      gstrObject: " & gstrObject & _
                Chr(10) & Chr(13) & _
                "      gstrCode: " & gstrCode & _
                Chr(10) & Chr(13) & _
                "      gstrlogin: " & gstrlogin & _
                Chr(10) & Chr(13) & _
                Chr(10) & Chr(13) & _
                "INTERNAL VARIABLES: " & _
                "      gstrMessage: " & gstrMessage & _
                Chr(10) & Chr(13) & _
                "      gdtTime: " & gdtTime & _
                Chr(10) & Chr(13) & _
                "      gstrINSERT: " & gstrINSERT & _
                Chr(10) & Chr(13) & _
                "      gstrVALUES: " & gstrVALUES & _
                Chr(10) & Chr(13) & _
                Chr(10) & Chr(13) & _
                "      gstrSQL: " & gstrSQL & _
                Chr(10) & Chr(13) & _
                Chr(10) & Chr(13) & _
                "ERROR " & _
                "      " & Err.Number & ": " & Err.Description
                
    
    Debug.Print strError
    MsgBox strError, vbCritical, "fnLogError encountered an error"
    Resume Exit_fnLogError

End Function


Public Function fnRecordLogin()
'//////////////////////////////////////////////////////////////////
'// Function: fnLogError
'//////////////////////////////////////////////////////////////////
'// Author: Tranchemontaigne
'//////////////////////////////////////////////////////////////////
'// Modified:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     07 Mar 2013     Tranchemontaigne   -Improved documentation
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     Records login ID in use when the database is opened
'//
'//////////////////////////////////////////////////////////////////
'// Input:
'//     Variable        Description
'//     ===========================================================
'//     gstrMessage     Windows User ID
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     fnGet_UserID    (Windows API module)
'//     fnLogError      (ErrorLog module)
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnRecordLogin

Dim gstrlogin As String
Dim gdtTime As Date
Dim gstrINSERT As String
Dim gstrVALUES As String
Dim gstrSQL As String
Dim gstrMessage As String

    gstrlogin = fnGet_UserID
    gdtTime = Now()
    gstrMessage = "login"
    gstrINSERT = "INSERT INTO t99_Error_Log( [t99_Time], [t99_Login], [t99_Message] )"
    gstrVALUES = "VALUES (" & Chr(34) & gdtTime & Chr(34) & ", " & Chr(34) & _
        gstrlogin & Chr(34) & ", " & Chr(34) & gstrMessage & Chr(34) & ");"
    gstrSQL = gstrINSERT & " " & gstrVALUES
    With DoCmd
        .SetWarnings False
        .RunSQL gstrSQL
        .SetWarnings True
    End With
    
Exit_fnRecordLogin:
    Exit Function
    
Err_fnRecordLogin:
    Debug.Print gstrSQL
    strError = "Error: " & Chr(10) & Chr(13) & _
        "     " & Err.Number & ": " & Err.Description

    MsgBox strError, vbCritical, "Error: cmdNetworkPath_Click"
    
    Call fnLogError(gstrObject, "cmdNetworkPath_Click", strError)
    Resume Exit_fnRecordLogin
    
End Function

Public Function fnRecordLogout()
'//////////////////////////////////////////////////////////////////
'// Function: fnLogError
'//////////////////////////////////////////////////////////////////
'// Author: Chris Taylor
'//////////////////////////////////////////////////////////////////
'// Modified:
'//     Date            Editor          Description
'//     ----------------------------------------------------------
'//     18 Jul 2013     Tranchemontaigne   -Created
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     Records user log out when the database is closed
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     fnGet_UserID    (Windows API module)
'//     fnLogError      (ErrorLog module)
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnRecordLogout

Dim gstrlogin As String
Dim gdtTime As Date
Dim gstrINSERT As String
Dim gstrVALUES As String
Dim gstrSQL As String
Dim gstrMessage As String

    gstrlogin = fnGet_UserID
    gdtTime = Now()
    gstrMessage = "logout"
    gstrINSERT = "INSERT INTO t99_Error_Log( [t99_Time], [t99_Login], [t99_Message] )"
    gstrVALUES = "VALUES (" & Chr(34) & gdtTime & Chr(34) & ", " & Chr(34) & _
        gstrlogin & Chr(34) & ", " & Chr(34) & gstrMessage & Chr(34) & ");"
    gstrSQL = gstrINSERT & " " & gstrVALUES
    With DoCmd
        .SetWarnings False
        .RunSQL gstrSQL
        .SetWarnings True
    End With
    
Exit_fnRecordLogout:
    Exit Function
    
Err_fnRecordLogout:
    Debug.Print gstrSQL
    strError = "Error: " & Chr(10) & Chr(13) & _
        "     " & Err.Number & ": " & Err.Description

    MsgBox strError, vbCritical, "Error: fnRecordLogout"
    
    Call fnLogError(gstrObject, "fnRecordLogout", strError)
    Resume Exit_fnRecordLogout
    
End Function
 
Last edited:
You must log in or register to reply here.

Similar threads

J
macro or function preventing saving date to a field.
Replies
9
Views
401
John Sh
J
M
Subform won't allow data entry/display form fields when record is empty
Replies
9
Views
623
Pat Hartman
P
J
MSOffice error message
Replies
7
Views
260
John Sh
J
Kayleigh
Not printing unbound boxes in subform footer
Replies
4
Views
222
LarryE
LarryE
Papashep
Solved Access vba Manage an Attachment field with vba
Replies
8
Views
636
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom