Check if network drive or not

[ccordner]

Hi

The idea of the routine is that the user clicks on a button, chooses a file and then it will insert a hyperlink to that file. Better still, it will work out the UNC path so that when the spreadsheet is sent to somebody else (or opened by somebody else) the links will still work.

However, for this reason it will only work when the file is saved on a network drive. Is there any way of checking to see if the drive is a network drive or not, so I can get some more meaningful error messages?

Thanks
Chris

' 32-bit Function version.' Enter this declaration on a single line.
Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias _
    "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal _
    lpszRemoteName As String, lSize As Long) As Long


' 32-bit declarations:
Dim lpszRemoteName As String
Dim lSize As Long


' Use for the return value of WNetGetConnection() API.
Const NO_ERROR As Long = 0


' The size used for the string buffer. Adjust this if you
' need a larger buffer.
Const lBUFFER_SIZE As Long = 255


Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim FileName As Variant
Dim NewFileName As String


Sub Button2_Click()


Filter = "View All Files (*.*),*.*,"
FilterIndex = 3
Title = "Select a File to Open"


With Application
    FileName = .GetOpenFilename(Filter, FilterIndex, Title)
End With


' Exit sub if 'Cancel' is pressed
If FileName = False Then
    
    Exit Sub
    
Else


    ' Trim the filename to find the mapped drive letter.
    DriveLetter = Left(FileName, 1) & ":"


    MsgBox (DriveLetter)


    ' Specifies the size in characters of the buffer.
    cbRemoteName = lBUFFER_SIZE


    ' Prepare a string variable by padding spaces.
    lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)


    ' Return the UNC path (\\Server\Share).
    lstatus& = WNetGetConnection32(DriveLetter, lpszRemoteName, _
    cbRemoteName)


    ' Verify that the WNetGetConnection() succeeded. WNetGetConnection()
    ' returns 0 (NO_ERROR) if it successfully retrieves the UNC path.
    If lstatus& = NO_ERROR Then


        'Add UNC path to beginning of FileName
        NewFileName = Left(Trim(lpszRemoteName), (Len(Trim(lpszRemoteName)) - 1)) & "\" & Right(FileName, (Len(FileName) - 3))


        Else


        MsgBox ("An error has occurred with" & Chr(10) & lstatus& & Chr(10) & ". This device will self-destruct in thirty seconds.")
        Exit Sub


    End If


    'Copy FileName to ActiveCell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=NewFileName, SubAddress:= _
    "", TextToDisplay:=ActiveCell.Text


End If


End Sub

 

[VBA Geek]

Have a look at: https://msdn.microsoft.com/en-us/library/office/gg264195.aspx