Add Hyperlink Via Button

[PMal]

Hello,

I have a form which contains a hyperlink to a document. Each record should have a document attached and, being lazy, I want to avoid right click - link-edit and just add the destination at the click of a button. I've added the 'add link' button to my form but at present, this doesn't do anything. Is there any code I can put behind it to open up the address box for a hyperlink.

Hope this makes sense.

[ranman256]

1. your doc link does not seem complete, i needs c:\folder\....

2. I use this code to open anything.
if the value in the textbox is a word doc file, it will open in word, same for excel, etc
it just needs the full path to the doc.


'whatever path is in the textbox will open in its native application
OpenNativeApp txtBox


paste this code into a module

#If Win64 Then      'Public Dclare PtrSafe Function
  Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
#else
  Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If


Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&




Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String


r = StartDoc(psDocName)
If r <= 32 Then
    'There was an error
    Select Case r
        Case SE_ERR_FNF
            msg = "File not found"
        Case SE_ERR_PNF
            msg = "Path not found"
        Case SE_ERR_ACCESSDENIED
            msg = "Access denied"
        Case SE_ERR_OOM
            msg = "Out of memory"
        Case SE_ERR_DLLNOTFOUND
            msg = "DLL not found"
        Case SE_ERR_SHARE
            msg = "A sharing violation occurred"
        Case SE_ERR_ASSOCINCOMPLETE
            msg = "Incomplete or invalid file association"
        Case SE_ERR_DDETIMEOUT
            msg = "DDE Time out"
        Case SE_ERR_DDEFAIL
            msg = "DDE transaction failed"
        Case SE_ERR_DDEBUSY
            msg = "DDE busy"
        Case SE_ERR_NOASSOC
            msg = "No association for file extension"
        Case ERROR_BAD_FORMAT
            msg = "Invalid EXE file or error in EXE image"
        Case Else
            msg = "Unknown error"
    End Select
'    MsgBox msg
End If
End Sub




Private Function StartDoc(psDocName As String) As Long
Dim Scr_hDC As Long


Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
End Function

[PMal]

I don't think I explained what I want very well. I have no issues with opening the hyperlink as it is just a file path to the network drive.

at present to add a hyper link, I right click the text box - > select 'Hyperlink' -> select 'edit hyperlink' and then the search box pops up (as pictured). I want to be lazy and add a button next to the text called 'Add Link' so the address box appears with one click

[ranman256]

exactly. NO more edit hyperlink. Just edit the file path in the box. How easy.

[PMal]

exactly. NO more edit hyperlink. Just edit the file path in the box. How easy.

That means me writing our full file paths for new records....even more time consuming

[moke123]

Personally I find HyperLink datatype to be a P.I.T.A. to work with.
Like RanMan I use a text datatype and use a similiar procedure to open it in its native program.

[moke123]

That means me writing our full file paths for new records....even more time consuming

I use either a file picker, folder picker or cut & paste for the paths. Have never typed them.

when dealing with mapped drives in a network use the Unc path to avoid different mapping with different computers

Function GetUNC(strMappedDrive As String) As String


    Dim objFso As FileSystemObject
    On Error GoTo GetUNC_Error


    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


    On Error GoTo 0
    Exit Function


GetUNC_Error:


    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetUNC of Module modAlwaysIncluded"


End Function