Converting Hyperlinks from Network Drive to UNC Path

[CDBPlattco]

Hi All,

I have a database that lets engineers link to engineering drawings in the processing record using a hyperlink. Although we've had the discussion many times, occasionally the engineers will forget to browse via the Network Drives and go via their mapped drives instead. Thus you have a file path that references a drive letter (G:\\etc\etc\) rather than the UNC path. Given that everyone has different drive letters, it creates some issues.

I'm looking for a vba code that I can call either "OnClose" or as a routine part of my database cleanup that will identify hyperlinks that use a drive letter and convert them to the UNC path instead.

I'm only just starting to pull the code together now, but I'm still learning so I can see the time it's going to take me. Therefore if someone has a version I can shamelessly plagiarize I would be forever grateful!

Regards,
CDB

 

[Ranman256]

 if left([path],1) <> "\" then msgbox "use UNC path on drive"

 

[CDBPlattco]

TBH, I didn't even think of that one! That would certainly take care of all future events, but I still have quite a few old versions to convert and I really was hoping to find a quick way to do it rather than having to go and fix them all manually.

 

[moke123]

Function GetUNC(strMappedDrive As String) As String

    Dim objFso As FileSystemObject
    Set objFso = New FileSystemObject
    Dim strDrive As String
    Dim strShare As String

    'Separated the mapped letter from
    'any following sub-folders
    strDrive = objFso.GetDriveName(strMappedDrive)

    'find the UNC share name from the mapped letter
    strShare = objFso.Drives(strDrive).ShareName

    'The Replace function allows for sub-folders
    'of the mapped drive
    GetUNC = Replace(strMappedDrive, strDrive, strShare)

    Set objFso = Nothing    'Destroy the object

End Function

 

[CDBPlattco]

This seems to be working, although I still have some more testing to do. It's not the most elegant solution ever

Function GETNETWORKPATH(ByVal DriveName As String) As String
    
    Dim objNtWork  As Object
    Dim objDrives  As Object
    Dim lngLoop    As Long
    
    
    Set objNtWork = CreateObject("WScript.Network")
    Set objDrives = objNtWork.enumnetworkdrives
    
    For lngLoop = 0 To objDrives.Count - 1 Step 2
        If UCase(objDrives.Item(lngLoop)) = UCase(DriveName) Then
            GETNETWORKPATH = objDrives.Item(lngLoop + 1)
            Exit For
        End If
    Next

End Function

Private Sub Form_AfterUpdate()

    Dim sDrive As String
    Dim sUNC As String
    Dim Result As String
   
    sDrive = Left([Hyperlink], 2)
   
    sUNC = GETNETWORKPATH(sDrive)
    
    If Left([Hyperlink], 1) <> "\" Then
        
        Result = Replace(Me.Hyperlink, sDrive, sUNC)
        
        Hyperlink = Result
        
    End If

End Sub