Question

我在Access 2010中有一个表单，允许用户查找Excel文件并对其进行映射，以便可以从其他表单轻松访问它。我认为，最简单的解释方法是用图片说明：

Mapping Form

表单包含此On Load事件：

Private Sub Form_Load()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim sPath As String
Set db = CurrentDb

On Error GoTo Error_Handler

sPath = Application.CurrentProject.Path

sSQL = "Select Setting from tblBackendFiles where Code = 'SourceVerification'"
Set rs = db.OpenRecordset(sSQL)
Me.tVerificationPath = Nz(rs!Setting, "")
If Len(Me.tVerificationPath) = 0 Then
    Me.tExcelPath = sPath
End If
Me.cmdAcceptPath.SetFocus
rs.Close

GoTo exit_sub

Error_Handler:
MsgBox Err.number & ": " & Err.Description, vbInformation + vbOKOnly, "Error!"

exit_sub:
Set rs = Nothing
Set db = Nothing

End Sub

我想要的是在文本框中显示Excel文件的当前路径，该路径当前是未绑定的。我在网上看了一下，但我很难找到如何实际出现的路径。

最好的方法是什么？如果可能的话，我宁愿在没有VBA的情况下这样做，但我不是百分之百反对它。

Answer 1

我已多次这样做了。您必须创建一个表单。在该表单上，放置一个名为＆＃34; tbFile＆＃34;的文本框，另一个名为＆＃34; tbFileName＆＃34; （这是不可见的）和一个名为＆＃34; bBrowse＆＃34;。

的按钮

然后，在您的表单后面，输入：

Option Compare Database
Option Explicit

Private Sub bBrowse_Click()
On Error GoTo Err_bBrowse_Click

    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant

    Me.tbHidden.SetFocus

'   strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
'    & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
'    strFilter = "Access Files (*.mdb)" & vbNullChar & "*.mdb*"
    strFilter = "All Files (*.*)" & vbNullChar & "*.*"

    lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly

    varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strInitialDir:="C:\Windows\", _
    strDialogTitle:="Find File (Select The File And Click The Open Button)")
    'remove the strInitialDir:="C:\Windows\", _ line if you do not want the Browser to open at a specific location

    If IsNull(varFileName) Or varFileName = "" Then
        Debug.Print "User pressed 'Cancel'."
        Beep
        MsgBox "File selection was canceled.", vbInformation
        Exit Sub
    Else
        'Debug.Print varFileName
        tbFile = varFileName
    End If

    Call ParseFileName

Exit_bBrowse_Click:
    Exit Sub

Err_bBrowse_Click:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_bBrowse_Click

End Sub

Private Function ParseFileName()
On Error GoTo Err_ParseFileName

    Dim sFullName As String
    Dim sFilePathOnly As String
    Dim sDrive As String
    Dim sPath As String
    Dim sLocation As String
    Dim sFileName As String

    sFullName = tbFile.Value

    ' Find the final "\" in the path.
    sPath = sFullName

    Do While Right$(sPath, 1) <> "\"
    sPath = Left$(sPath, Len(sPath) - 1)
    Loop

    ' Find the Drive.
    sDrive = Left$(sFullName, InStr(sFullName, ":") + 1)
    'tbDrive = sDrive

    ' Find the Location.
    sLocation = Mid$(sPath, Len(sDrive) - 2)
    'tbLocation = sLocation

    ' Find the Path.
    sPath = Mid$(sPath, Len(sDrive) + 1)
    'tbPath = sPath

    ' Find the file name.
    sFileName = Mid$(sFullName, Len(sPath) + 4)
    tbFileName = sFileName

Exit_ParseFileName:
    Exit Function

Err_ParseFileName:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_ParseFileName

End Function

然后，创建一个新模块并将其粘贴到其中：

Option Compare Database
Option Explicit

Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
 Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
 Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean

Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Type tsFileName
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   strFilter As String
   strCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   strFile As String
   nMaxFile As Long
   strFileTitle As String
   nMaxFileTitle As Long
   strInitialDir As String
   strTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   strDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type

' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
    Optional ByRef rlngflags As Long = 0&, _
    Optional ByVal strInitialDir As String = "", _
    Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
    Optional ByVal lngFilterIndex As Long = 1, _
    Optional ByVal strDefaultExt As String = "", _
    Optional ByVal strFileName As String = "", _
    Optional ByVal strDialogTitle As String = "", _
    Optional ByVal fOpenFile As Boolean = True) As Variant
On Error GoTo tsGetFileFromUser_Err

    Dim tsFN As tsFileName
    Dim strFileTitle As String
    Dim fResult As Boolean

    ' Allocate string space for the returned strings.
    strFileName = Left(strFileName & String(256, 0), 256)
    strFileTitle = String(256, 0)

    ' Set up the data structure before you call the function
    With tsFN
        .lStructSize = Len(tsFN)
        .hwndOwner = Application.hWndAccessApp
        .strFilter = strFilter
        .nFilterIndex = lngFilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle
        .flags = rlngflags
        .strDefExt = strDefaultExt
        .strInitialDir = strInitialDir
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
        .lpfnHook = 0
    End With

    ' Call the function in the windows API
    If fOpenFile Then
        fResult = ts_apiGetOpenFileName(tsFN)
    Else
        fResult = ts_apiGetSaveFileName(tsFN)
    End If

    ' If the function call was successful, return the FileName chosen
    ' by the user.  Otherwise return null.  Note, the CancelError property
    ' used by the ActiveX Common Dialog control is not needed.  If the
    ' user presses Cancel, this function will return Null.
    If fResult Then
        rlngflags = tsFN.flags
        tsGetFileFromUser = tsTrimNull(tsFN.strFile)
    Else
        tsGetFileFromUser = Null
    End If

tsGetFileFromUser_End:
    On Error GoTo 0
    Exit Function

tsGetFileFromUser_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsGetFileFromUser"
    Resume tsGetFileFromUser_End

End Function

' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
    Dim I As Integer

    I = InStr(strItem, vbNullChar)
    If I > 0 Then
        tsTrimNull = Left(strItem, I - 1)
    Else
        tsTrimNull = strItem
    End If

tsTrimNull_End:
    On Error GoTo 0
    Exit Function

tsTrimNull_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsTrimNull"
    Resume tsTrimNull_End

End Function

Public Sub tsGetFileFromUserTest()
On Error GoTo tsGetFileFromUserTest_Err

    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant

'   strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
'    & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
    strFilter = "All Files (*.*)" & vbNullChar & "*.*"

    lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly

    varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strDialogTitle:="GetFileFromUser Test (Please choose a file)")

    If IsNull(varFileName) Then
        Debug.Print "User pressed 'Cancel'."
    Else
        Debug.Print varFileName
        'Forms![Form1]![Text1] = varFileName
    End If

    If varFileName <> "" Then MsgBox "You selected the '" & varFileName & "' file.", vbInformation

tsGetFileFromUserTest_End:
    On Error GoTo 0
    Exit Sub

tsGetFileFromUserTest_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
     & " in sub basBrowseFiles.tsGetFileFromUserTest"
    Resume tsGetFileFromUserTest_End

End Sub

VOILA！很简单。 ; O）

在Access 2010表单中显示文件路径

1 个答案: