Hyperlinks (UNC)

[ccordner]

Hi

I have some code (reproduced below) from a button in Excel which opens the 'Browse' button for the user to select a file, it then puts a link to that file in the cell, using the UNC path.



How do I adapt this to work for Access?

I want to store a link to a file in a table.

Thanks
Chris

P.S. Ideally, the full link wouldn't show, only the document name.

' 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()
If Not ActiveCell.Column = 7 Then
    Exit Sub
    ElseIf ActiveCell.Row < 4 Then
    Exit Sub
    ElseIf ActiveCell.Row > 203 Then
    Exit Sub
End If
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 (\\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) & "Please contact C Cordner. 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:=Right(NewFileName, (Len(NewFileName) - InStrRev(NewFileName, "\")))
End If

[June7]

Check out
http://bytes.com/topic/access/answer...-file-save-url
http://www.allenbrowne.com/casu-09.html
http://allenbrowne.com/func-GoHyperlink.html