VBA help to find folder UNC path & file UNC path

[KelvinLGW]

Hi all,

1. I have built created a code that when I right click on certain cells it will allow me to browse for a file using the windows browser, when selected - the name of the file is pasted into the cell I right clicked on and creates a link to the file so I can simply just click on the link and it will take me to the file directly.

2. What I want now is, if for some reason I change the file location the link will no longer work. My idea is to have the ability to have a separate macro that will allow me to select the master folder that these files come from, so all I have to do is alter the master folder path and the links will still work (given the file names aren't changed, which they won't be).

The difficult part is that these files will be stored on a network drive as multiple people will require access to these files, however, not everyone will have these mapped to the same drives hence why I require the UNC path.

Here is what my code looks like to achieve the first part:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    
If Not Intersect(Target, Range("F5:F1000")) Is Nothing Then 'If user right click's on any cell within the range F5 to F1000 then
                                                            'this subroutine will run
    
    MyFileLocation = Application.GetOpenFilename() 'Opens up windows browser and allows user to browse for required file
    
    Filename = Split(MyFileLocation, "\")(UBound(Split(MyFileLocation, "\"))) 'Saves the selected file name
    filePath = Left(MyFileLocation, InStrRev(MyFileLocation, "\")) 'Saves the file path
    
    fDialog.InitialFileName = filePath 'Sets the file path as the initial location in the windows browser
    
        If MyFileLocation = False Then 'If no file is selected or cancel is selected
        Cancel = True
            Exit Sub                   'then exit sub, aka do nothing
        
        Else
            Target = Filename          'If a file is selected then the target value will be the file name


        End If
        Cancel = True
        
            If Selection <> "" Then    'If selection is not blank then create a hyperlink to the file
                                       'Otherwise do nothing


                    With Target
                     .Hyperlinks.Add Anchor:=Selection, _
                     Address:=MyFileLocation, _
                     TextToDisplay:=Filename
                    End With


            Else
            End If
    
End If


End Sub

 

[FormR]

Hi, maybe this will help:

VBA to Return the UNC(Universal Naming Convention) Path of a Mapped Network Drive

 

[KelvinLGW]

I have seen this one many times, but this requires you to input the mapped drive into the code: i.e. P:, I want it so that you can choose the folder location using something similar to application.getopenfilename , and the code will save down the folder UNC path (maybe paste it into a cell so the user knows which folder is the master folder. From that saved folder UNC path, I can then combine the name of the link with the master folder path, so if all the files are moved or the folder has changed name I can merely change the master folder path and all the links will work rather than going to each one and re-selecting all the files.

Here is an example of what I mean by selecting the folder location (but this only retrieves the path not the UNC path):

Function BrowseForFolder(Optional OpenAt As Variant) As Variant     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level




     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)


     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.path


    On Error GoTo 0


     'Destroy the Shell Application
    Set ShellApp = Nothing


     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = "\"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select




    Exit Function


Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

 

[Norie]

Doesn't the path returned when you select a file include the mapped drive letter?

If it does you could extract that and pass it to the function FormR has suggested.

 

[FormR]

As Norie suggests, with the UDF code added to a regular module you could try something like this (from your first code):

                    With Target
                     .Hyperlinks.Add Anchor:=Target, _
                     Address:=GETNETWORKPATH(Left(MyFileLocation, 2)) & Mid(MyFileLocation, 3), _
                     TextToDisplay:=Filename
                    End With

 

[KelvinLGW]

Is there a way to apply it to my folder code (code shown again below)

Function BrowseForFolder(Optional OpenAt As Variant) As Variant     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level




     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)


     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.path


    On Error GoTo 0


     'Destroy the Shell Application
    Set ShellApp = Nothing


     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = "\"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select




    Exit Function


Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

 

[KelvinLGW]

Nevermind, I have managed to figure it out, fairly straight forward. Thanks for you help guys.