VBA to find file location

[ccordner]

I found a code snippet (I think on here) which brings up the standard "Open File" Dialog, so that the user can find a file.

It then returns the file path to the active cell as a link.

The only problem is that if the file is on a network drive (Which it will almost certainly always be), it returns the path as mapped on the user's computer.

So, say the file is on \\fps01\shares\revenue and the filename is "Sample.doc", if the user has that drive mapped to "Z", it returns the filename:

Z:\Sample.doc

When I want it to return:

\\fps01\shares\revenue\Sample.doc

Is this possible?

Chris

Sub Button2_Click()
Dim Filter As String, Title As String
Dim FilterIndex As Integer
Dim Filename As Variant
Filter = "View All Files (*.*),*.*," & _
         "Microsoft Excel Spreadsheet (*.xls),*.xls," & _
         "Microsoft Word Document (*.doc),*.doc,"
FilterIndex = 3
Title = "Select a File to Open"
With Application
    Filename = .GetOpenFilename(Filter, FilterIndex, Title)
End With
If Filename = False Then
    Exit Sub
    Else
    
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Filename, SubAddress:= _
        "", TextToDisplay:=Filename
End If
End Sub

 

[ChrisM]

Yes you can do this, sorry don't have the code at my fingertips though, it's back at home. The magic word you are looking for is UNC,that's the path in the \\xx\ format.

Do a search to convert a mapped drive to UNC and you should find what you need.

 

[JamesW]

Hi,

Take a look at this, it should be of help (you just need to change the Input Box to get open file dialog):

http://support.microsoft.com/kb/160529

 

[ccordner]

Thanks.

I've kind of got this working.

The code below works in except for the last bit.

Having worked out the UNC path for the drive, I tried to append the filename to the UNC path to produce the complete address of the file.

Unfortunately, it just gives me the UNC path of the drive.

Any ideas why?

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
Sub Button2_Click()
Filter = "View All Files (*.*),*.*," & _
    "Microsoft Excel Spreadsheet (*.xls),*.xls," & _
    "Microsoft Word Document (*.doc),*.doc,"
FilterIndex = 3
Title = "Select a File to Open"
With Application
    FileName = .GetOpenFilename(Filter, FilterIndex, Title)
End With
If FileName = False Then
    Exit Sub
    Else
    
    ' Trim the filename to find the mapped drive letter.
    DriveLetter = Left(FileName, 1) & ":"
    ' 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 ([URL="file://server/Share"]\\Server\Share[/URL]).
    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
        FileName = lpszRemoteName & FileName = lpszRemoteName & Right(FileName, (Len(FileName) - 3))
    End If
    'Copy FileName to ActiveCell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=FileName, SubAddress:= _
    "", TextToDisplay:=FileName
End If
End Sub

 

[ChrisM]

You got a little over eager with your equal signs,

FileName = lpszRemoteName & FileName = lpszRemoteName & Right(FileName, (Len(FileName) - 3))

Think this should be something like:

NewFileName = lpszRemoteName & FileName

 

[ccordner]

Sorry

That was because my original code was

FileName = lpszRemoteName & FileName

But I modified it to avoid getting something like \\Server\Share\X:\Sample.doc.

I then copied this and forgot to delete the original. This is how the code actually looks like this:

FileName = lpszRemoteName & Right(FileName, (Len(FileName) - 3))

Just tried your version and had the same problem!

Thanks
Chris

 

[ChrisM]

Easiest way to troubleshoot is to just run in debug mode.

Put a break point at:

If FileName = False Then

then run your macro. The line above will be highlighted in yellow. Hover your mouse over the word "filename" and see what pops up. Is it what you expect?

Push F8 to step through your code a line at a time. At each relevant line, hover your mouse over "filename" again and check the value of it. You should quickly see where things are going wrong.

Just remember, when you hover your mouse, you won't see the results of the currently highlighted line until you step down to the next line. The yellow line hasn't executed yet.

 

[ccordner]

Thanks for that. I've never really understood how to step-through code before.

I've solved the problem, but it appears to be a bit of a "bodge".

1) The string is prepared by adding spaces, so one of the problems was solved by "trimming" the spaces at the end of the UNC.

2) However, for some reason there was a character at the end (In debug mode it showed as a square and I think it was actually a carriage return) so I took the left hand part of the UNC (minus the last character) and then spliced on a "\" at the end just to make it fit.

I am curious to know what the character is though and why it is added in!

Finally, I modified the link to just show the file name and not the path, to make it a little more user-friendly!

' 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, NewFileName As Variant
Sub Button2_Click()
Filter = "View All Files (*.*),*.*," & _
    "Microsoft Excel Spreadsheet (*.xls),*.xls," & _
    "Microsoft Word Document (*.doc),*.doc,"
FilterIndex = 3
Title = "Select a File to Open"
With Application
    FileName = .GetOpenFilename(Filter, FilterIndex, Title)
End With
If FileName = False Then
    Exit Sub
    Else
    
    ' Trim the filename to find the mapped drive letter.
    DriveLetter = Left(FileName, 1) & ":"
    ' 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 ([URL="file://\\Server\Share"]\\Server\Share[/URL]).
    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))
    End If
    'Copy FileName to ActiveCell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=NewFileName, SubAddress:= _
    "", TextToDisplay:=Right(NewFileName, (Len(NewFileName) - InStrRev(NewFileName, "\")))
End If
End Sub

 

[ccordner]

When I get an error on WNetGetConnection, is there anywhere I can decode the error messages?

Thanks
Chris

 

[ChrisM]

See if this helps:

http://msdn.microsoft.com/en-us/library/aa385453.aspx

If this is not the granularity you are looking for, then as the article mentioned, you have to make another API call to the error object and read that.