訪問和文件選取器

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