Check if network drive or not

ccordner

Active Member
Joined
Apr 28, 2010
Messages
355
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

Code:
' 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
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top