访问和文件选择器

Question

我想用文件路径填充文本框，以便我可以将文件路径作为超链接添加到记录中。

我创建了一个按钮并编写了这个子程序：

Private Sub Browsebutt_Click()
Dim fd As Object
Set fd = Application.FileDialog(3) 'msoFileDialogFilePicker
With fd
    .Filters.Clear
    .InitialFileName = CurrentProject.Path & "\"
    .Title = "Select File"
    .AllowMultiSelect = False
    .ButtonName = "Select"
    .Filters.Add "All Files (*.*)", "*.*"
    '.InitialView = msoFileDialogViewList'
    If .Show Then
        Me.Offlink = .SelectedItems(1)
        Else
        Exit Sub
    End If

End With

一切看起来都很好，但问题是当我浏览到存储在公司 NAS 中的内容时。路径如下所示：

Z:\Folder1\文件

它在点击时不起作用，如果不是这个我使用拖放功能直接进入访问表（不是在表单中）我会得到这样的东西：

\192.168.0.155\archive\Folder1\File

它确实有效，当我点击链接时，它会打开我的文件。

所以我想知道是否有办法让文件选择器为路径提供完整的 ip。

Answer 1

回答这个问题需要一些步骤，并且可能稍微取决于您的设置：

您无法大量更改文件选择器的行为，因此我将更改 UNC 路径的驱动器号。根据驱动器的映射方式，它会返回服务器名称（例如 \\MyServer 或 \\www.AnUrl.tld）或 IP 地址

首先，我将使用我找到的几个辅助函数 here，它们适用于后期绑定并提高可用性。

助手 1：输入：完整路径。输出：来自该路径的驱动器号

Public Function ParseDriveLetter(ByVal path As String) As String
    'Get drive letter from path
    ParseDriveLetter = vbNullString
    On Error GoTo err_ParseDriveLetter
    Dim oFileSystem As Object ' Scripting.FileSystemObject
    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    Dim oFolder As Object 'Scripting.Folder
    '    Next line throws error if mapping not available
    Set oFolder = oFileSystem.GetFolder(path)
    If (oFolder Is Nothing) Then
        Debug.Print "ParseDriveLetter: Folder '" & path & "' is invalid"
    Else
        ParseDriveLetter = oFileSystem.GetDriveName(oFolder.path)
    End If
    Set oFolder = Nothing
    Set oFileSystem = Nothing
    Exit Function

err_ParseDriveLetter:
    Select Case Err.Number
    Case 76:
        '    Path not found -- invalid drive letter or letter not mapped
    Case Else
        MsgBox "Error no. " & CStr(Err.Number) & ": " & Err.Description & vbNewLine & _
            "Was caused by " & Err.Source, vbOKOnly Or vbExclamation, "Error in function ParseDriveLetter"
    End Select
End Function

助手 2：输入：来自映射网络驱动器的驱动器号。输出：驱动器映射到的位置

Public Function GetMappedPathFromDrive(ByVal drive As String) As String
    Dim oWshNetwork As Object 'New WshNetwork
    Dim oDrives As Object 'New WshCollection
    Set oWshNetwork = CreateObject("WScript.Network")
    '   The EnumNetworkDrives method returns a collection.
    '   This collection is an array that associates pairs of items ? network drive local names and their associated UNC names.
    '   Even-numbered items in the collection represent local names of logical drives.
    '   Odd-numbered items represent the associated UNC share names.
    '   The first item in the collection is at index zero (0)
    Set oDrives = oWshNetwork.EnumNetworkDrives
    Dim i                                   As Integer
    For i = 0 To oDrives.Count - 1 Step 2
        '   Drive is oDrives.Item(i), UNC is oDrives.Item(i + 1)
        If (0 = StrComp(drive, oDrives.Item(i), vbTextCompare)) Then
            '   We have matched the drive letter.  Copy the UNC path and finish
            GetMappedPathFromDrive = oDrives.Item(i + 1)
            Exit For
        End If
    Next
    Set oDrives = Nothing
    Set oWshNetwork = Nothing
End Function

现在，您的代码中的实现：

Me.Offlink = Replace(.SelectedItems(1), ParseDriveLetter(.SelectedItems(1)), GetMappedPathFromDrive(ParseDriveLetter(.SelectedItems(1))))

请注意，如果这返回服务器名称而不是 IP 地址，您可以使用 @June7 引用的帖子来获取 IP 地址。