CODEWITHSUNDEEP
ms-accessfilepicker
nearchos
nearchos

Reputation: 43

Access and File Picker

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.

Upvotes: 0

Views: 1115

Answers (1)

Erik A
Erik A

Reputation: 32642

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.

Upvotes: 1

Related Questions