Access and File Picker - ms-access

Question

I want to fill a textbox with a file path so that I can then add the filepath as a hyperlink in a record.
I created a button and wrote this subroutine:
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
Everything looks fine but the issue is when I browse to something stored in my company NAS. The path looks like this:
Z:\Folder1\File
It doesn't work on click, if instead of this I use the drag and drop function directly into the access table (not in the form) I obtain something like this:
\192.168.0.155\archive\Folder1\File
and it actually works, when I click on the link it opens my file.
So I was wondering if there is a way to have the file picker to provide the path with full ip.

Answer 1

Answering this will require some steps, and might depend slightly on your setup:
You can't change the file picker behaviour a lot, so I'm going to change out the drive letter for the UNC path. Depending on how your drive is mapped, it will either return a server name (such as \\MyServer or \\www.AnUrl.tld), or an IP address
First, I'm going to use a couple of helper functions I found here and adapted to use late bindings and increase usability.
Helper 1: Input: a full path. Output: the drive letter from that path
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
Helper 2: Input: a drive letter from a mapped network drive. Output: the location the drive is mapped to
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
And now, the implementation in your code:
Me.Offlink = Replace(.SelectedItems(1), ParseDriveLetter(.SelectedItems(1)), GetMappedPathFromDrive(ParseDriveLetter(.SelectedItems(1))))
Note that if this returns the server name instead of the IP address, you can use the post #June7 referred to to get the IP address.