Follow Hyperlink help please

ChunkyChats

Registered User.
Local time
Today, 22:56
Joined
Jul 1, 2016
Messages
20
Hi, Im afraid my VBA knowledge is poor, but I am progressing. I have a folder icon on a form which when a user clicks it should take them to the associated folder on our network. I've tried building an onclick event with little success.

The network address is stored in a table (tblMaster_Data) in the field EmployeeFiles, Could anyone help me with the question mark in the code below please?

Application.FollowHyperlink Me.?

Many Thanks in advance

Steve
 

Attachments

  • onclickimage.JPG
    onclickimage.JPG
    21.4 KB · Views: 162
  • link.JPG
    link.JPG
    43.2 KB · Views: 153
Hi, I've been taking a look around the internet and have found this piece of code:

Private Sub Image92_Click()
Dim sBasePath As String
Dim sBaseFileName As String

sBasePath = "\\SPFS01\shared\QualityandSafety\QA Common\Quality (Q1)\Authorisations\ENGINEERING RECORDS\"
sBaseFileName = "LastName_FirstName"

Application.FollowHyperlink sBasePath & sBaseFileName Its this bit I can't seem to get right?

Steve
 
That will only work if the target object is a file, unfortunately not a folder.
Copy and paste the following into a new module. Save it as BasicFunctions or similar;
Code:
Option Compare Database
Option Explicit

'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

'***************Usage Examples***********************
'Open a folder:     ?fHandleFile("C:\TEMP\",WIN_NORMAL)
'Call Email app:    ?fHandleFile("mailto:dash10@hotmail.com",WIN_NORMAL)
'Open URL:          ?fHandleFile("http://home.att.net/~dashish", WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
'                   ?fHandleFile("C:\TEMP\TestThis",Win_Normal)
'Start Access instance:
'                   ?fHandleFile("I:\mdbs\CodeNStuff.mdb", Win_NORMAL)
'****************************************************

Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********

Then to call a file or a folder use it like this ;

Code:
     Dim sBasePath As String
     Dim sBaseFileName As String

     sBasePath = "\\SPFS01\shared\QualityandSafety\QA Common\Quality (Q1)\Authorisations\ENGINEERING RECORDS\"
     sBaseFileName = "LastName_FirstName"

     Call fHandleFile( sBasePath & sBaseFileName , WIN_NORMAL)
 
So at the moment your code works out to:

Followhyperlink "\\SPFS01\shared\QualityandSafety\QA Common\Quality (Q1)\Authorisations\ENGINEERING RECORDS\LastName_FirstName"

Presumably you want LastName_FirstName to be replaced by the fields in your table?

if that's the case replace the line:
sBaseFileName = "LastName_FirstName"

with (something like):
sBaseFileName = me!SubformName!LastName & " " & me!SubformName!FirstName

This is assuming LastName and Surname are held in a subform and the button you click is on the mainform?

Good luck! :)
 
if the underscore is part of the folder name it would be
Code:
sBaseFileName = me!SubformName!LastName & "_" & me!SubformName!FirstName
 
Reading this back I think I made a false assumption. Where exactly does this folder icon sit? is it on a form that shows Employees? From your screenshot it looks like a fairly standard form + subform setup (employees plus their certifications I would guess)

If that's the case you should be able to get away with:
Code:
 Private Sub Image92_Click()
Dim sBasePath As String
Dim sBaseFileName As String

sBasePath = "\\SPFS01\shared\QualityandSafety\QA Common\Quality (Q1)\Authorisations\ENGINEERING RECORDS\"
sBaseFileName = me!LastName & " " & me!FirstName
  
 [COLOR=black]Application.FollowHyperlink sBasePath & sBaseFileName 
[/COLOR]
end sub

Edit: Except if you need the underscore like Moke123 has said :)
 
Gents If I could kiss you I most certainly would. AWESOME!! thanks so much for the help.

It's working brilliantly.

Steve
 

Users who are viewing this thread

Back
Top Bottom