访问和文件选取器

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地址。