How to code for 'Attachment' datatype in MS Access 2007?

Question

I have a button in my Access 2007 form. On click, I need to open filedialog. I dont know how to attach the file selected to the 'Memo' field of a table using DAO.

Form details

Form : OrderForm Field: txtManagerProfile Button : btnFileBrowse

Table details

Table :ManagersProfile Memo field : Profile

Requirement:

'Profile' in table should accept any file and save it. Once the user selects the file, I need to show a open icon near to the 'txtManagerProfile' field in the form. On clicking the open button , I need to open any file. I am not used to this requirement before. Someone pls help. I am using DAO for populating other fields in the form.

Answer 1

In the below code I have a form with a text box named txtManagerProfile and a button named btnFileBrowse. When I click on the btnFileBrowse button a browser pops up that lets you browse to the file. When you select the file, the path is stored in the txtManagerProfile text box. If you double click on the txtManagerProfile text box the file gets opened up.

Here is the code behind the form:

'the open filename api
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As gFILE) As Long

' the gFILE type needed by the open filename api
Private Type gFILE
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter 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
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type


Private Function FileToOpen(Optional StartLookIn) As String
    'Purpose: Calls the open file api to let the user select the file to open
    'returns: string value which contains the path to the file selected. "" = no file seleted
    Dim ofn As gFILE, Path As String, filename As String, a As String

    ofn.lStructSize = Len(ofn)
    ofn.lpstrFilter = "All Files (*.*)"
    ofn.lpstrFile = Space$(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space$(254)
    ofn.nMaxFileTitle = 255

    If Not IsMissing(StartLookIn) Then ofn.lpstrInitialDir = StartLookIn Else ofn.lpstrInitialDir = "f:\Quoting"

    ofn.lpstrTitle = "SELECT FILE"
    ofn.Flags = 0

    a = GetOpenFileName(ofn)
    If (a) Then
        Path = Trim(ofn.lpstrFile)
        filename = Trim(ofn.lpstrFileTitle)
        If Dir(Path) <> "" Then
            FileToOpen = -1
            FileToOpen = Trim(ofn.lpstrFile)
        Else
            FileToOpen = ""
            Path = ""
            filename = ""
        End If
    End If

    FileToOpen = Path
End Function


Private Sub btnFileBrowse_Click()
   Dim MyPath As String
   MyPath = FileToOpen
   If (VBA.Strings.Len(MyPath & "") > 0) Then txtManagerProfile = MyPath
End Sub


Private Sub txtManagerProfile_DblClick(Cancel As Integer)
   On Error GoTo Err_My_Click
   Dim fso As Scripting.FileSystemObject
   Set fso = New Scripting.FileSystemObject

   'IF THE FILE DOES NOT EXIST THEN DISPLAY THE MESSAGE AND EXIT THE SUBROUTINE
   If (fso.FileExists(txtManagerProfile) = False) Then
      MsgBox "THE FILE PATH IS INCORRECT.", , "ERROR: INVALID FILE PATH"
      Exit Sub
   End If

   'USED TO CHECK IF THE FILE IS ALREADY OPENED AND LOCKED BY ANOTHER USER.
   Open txtManagerProfile For Binary Access Read Write Lock Read Write As #1
   Close #1

   Application.FollowHyperlink txtManagerProfile

Exit_My_Click:
   Exit Sub
Err_My_Click:
   If Err.Number = 486 Then
      MsgBox "YOU DO NOT HAVE THE PROGRAM INSTALLED THAT " & vbNewLine & _
             "IS USED TO VIEW THIS FILE.  CONTACT YOUR IT " & vbNewLine & _
             "MANAGER AND HAVE HIM/HER INSTALL THE NEEDED " & vbNewLine & _
             "APPLICATION.", , "ERROR: MISSING APPLCIATION"
   ElseIf Err.Number = 490 Then
      MsgBox "THE FILE PATH IS INCORRECT.", , "ERROR: INVALID FILE PATH"
   ElseIf Err.Number = 70 Or Err.Number = 75 Then
      MsgBox "THE FILE IS OPENED/LOCKED BY ANOTHER USER." & vbNewLine & _
             "THEY WILL HAVE TO CLOSE IT BEFORE YOU CAN " & vbNewLine & _
             "OPEN IT THROUGH PDC.", , "ERROR: FILE ALREADY OPEN"
   Else
      MsgBox ("ERROR MESSAGE:  " & Err.Description & vbNewLine & _
              "ERROR NUMBER:  " & Err.Number & vbNewLine & _
              "ERROR SOURCE:  " & Err.Source)
   End If
   Resume Exit_My_Click
End Sub

EDIT:

You could do something like the following to save the path into a table somewhere:

Private Sub cmdSave_Click()
   If (VBA.Strings.Len(txtManagerProfile & "") <> 0) Then
      DoCmd.SetWarnings False
      DoCmd.RunSQL "INSERT INTO MyTable (linkfile) VALUES ('" & _
                   txtManagerProfile & "')"
      DoCmd.SetWarnings True
      MsgBox "SUCCESSFULLY SAVED", , "SUCCESS"
   Else
      MsgBox "YOU MUST SELECT A FILE FIRST BEFORE SAVING", , "ERROR: NO FILE"
   End If
End Sub