Question

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

表格详情

表格：OrderForm 字段：txtManagerProfile 按钮：btnFileBrowse

表格详情

表：ManagersProfile 备注栏：档案

要求：

＆＃39;简介＆＃39;在表中应该接受任何文件并保存。一旦用户选择了该文件，我需要在“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

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

1 个答案: