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 \存档\ Folder1中\文件

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

所以我想知道是否有办法让文件选择器提供完整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地址，则可以使用post @ June7来获取IP地址。

访问和文件选择器

1 个答案: