如何在 MS Access 2007 中为“附件”数据类型编码？

Question

我的 Access 2007 表单中有一个按钮。单击时，我需要打开文件对话框。我不知道如何使用 DAO 将选定的文件附加到表的“备忘录”字段。

表单详情

表格：订单表格 字段：txtManagerProfile 按钮：btnFileBrowse

表格详情

表 :ManagersProfile 备注字段：个人资料

要求：

表中的“配置文件”应该接受任何文件并保存。用户选择文件后，我需要在表单中的“txtManagerProfile”字段附近显示一个打开图标。单击打开按钮时，我需要打开任何文件。我以前不习惯这个要求。有人请帮忙。我正在使用 DAO 填充表单中的其他字段。

Answer 1

在下面的代码中，我有一个表单，其中包含一个名为 txtManagerProfile 的文本框和一个名为 btnFileBrowse 的按钮。当我单击btnFileBrowse 按钮时，会弹出一个浏览器，让您浏览到该文件。选择文件时，路径将存储在txtManagerProfile 文本框中。如果你双击 txtManagerProfile 文本框，文件就会打开。

这是表单背后的代码：

'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

编辑：

您可以执行以下操作将路径保存到某处的表格中：

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