Hyperlink Not Working, Run-time error 7971

[vspsdca]

Hi,
I'm a newbie here and does not really have any formal training on VBA. I just need help to get my hyperlink to work. I have a form in MS Access with a browse button where a user can select a folder from a specified directory from our network. I was able to get the browse button working where it saves a path that is selected onto the textbox that is set as hyperlink. The problem appears when you click on the hyperlink... it will work a few times and afterwards I get this error message that it cannot follow the hyperlink. If I click the "End" button on the MS VB error message it works again. When I click "Debug" it sends me to the code where FollowHyperlink Me.ReqLink (where Reqlink is the name of my hyperlink box) is highlighted.

Below is my code for the browse button On Click command:

Private Sub SelFolder_Click()
Me.ReqLink = GetFolder(Me.hWnd, "J:\27 - BSSG\03 - ADMF\13 - Ellipse Change Requests")
End Sub

For the Click command on the Hyperlink:

Private Sub ReqLink_Click()
FollowHyperlink Me.ReqLink
End Sub

And the code for the Browse Button:

Private Type BrowseInfo
   hWndOwner As Long
   pIDLRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type
 
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_EDITBOX = &H10
Public Const BIF_VALIDATE = &H20
Public Const BIF_NEWDIALOGSTYLE = &H40
Public Const BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Public Const BIF_BROWSEINCLUDEURLS = &H80
Public Const BIF_UAHINT = &H100
Public Const BIF_NONEWFOLDERBUTTON = &H200
Public Const BIF_NOTRANSLATETARGETS = &H400
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_SHAREABLE = &H8000
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)
 
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
 
Private mstrSTARTFOLDER As String
Public Function GetFolder(ByVal hWndModal As Long, Optional StartFolder As String = "", Optional Title As String = "Please select a folder:", _
   Optional IncludeFiles As Boolean = False, Optional IncludeNewFolderButton As Boolean = False) As String
    Dim bInf As BrowseInfo
    Dim RetVal As Long
    Dim PathID As Long
    Dim RetPath As String
    Dim Offset As Integer
    'Set the properties of the folder dialog
    bInf.hWndOwner = hWndModal
    bInf.pIDLRoot = 0
    bInf.lpszTitle = Title
    bInf.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_STATUSTEXT
    If IncludeFiles Then bInf.ulFlags = bInf.ulFlags Or BIF_BROWSEINCLUDEFILES
    If IncludeNewFolderButton Then bInf.ulFlags = bInf.ulFlags Or BIF_NEWDIALOGSTYLE
    If StartFolder <> "" Then
       mstrSTARTFOLDER = StartFolder & vbNullChar
       bInf.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function.
   End If
    'Show the Browse For Folder dialog
    PathID = SHBrowseForFolder(bInf)
    RetPath = Space$(512)
    RetVal = SHGetPathFromIDList(ByVal PathID, ByVal RetPath)
    If RetVal Then
         'Trim off the null chars ending the path
         'and display the returned folder
         Offset = InStr(RetPath, Chr$(0))
         GetFolder = Left$(RetPath, Offset - 1)
         'Free memory allocated for PIDL
         CoTaskMemFree PathID
    Else
         GetFolder = ""
    End If
End Function
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
   On Error Resume Next
   Dim lpIDList As Long
   Dim ret As Long
   Dim sBuffer As String
   Select Case uMsg
       Case BFFM_INITIALIZED
           Call SendMessage(hWnd, BFFM_SETSELECTION, 1, mstrSTARTFOLDER)
       Case BFFM_SELCHANGED
           sBuffer = Space(MAX_PATH)
           ret = SHGetPathFromIDList(lp, sBuffer)
           If ret = 1 Then
               Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
           End If
   End Select
   BrowseCallbackProc = 0
End Function
Private Function GetAddressofFunction(add As Long) As Long
 GetAddressofFunction = add
End Function

*******************
Any help you can provide will be highly appreciated.

Many thanks,
Vspsdca

[ADezii]

In my opinion, your code is much too complicated for such a relatively simple task:

1. Create a Reference to the Microsoft Office XX.X Object Library
2. Execute the following code whereever appropriate:
   

   Dim strFolderName As String
   Dim result As Integer
    
   With Application.FileDialog(msoFileDialogFolderPicker)
     .Title = "View Folders For Hyperlink"     'Change if necessary
     .AllowMultiSelect = False        
     .ButtonName = "Select Folder"     'Change if necessary
     .InitialFileName = "C:\Windows\System32\"         'Change
     .InitialView = msoFileDialogViewLargeIcons        'Change if necessary
        result = .Show
        If (result <> 0) Then
          strFolderName = Trim(.SelectedItems.Item(1))
           Me![ReqLink] = strFolderName
        Else
          Me![ReqLink] = vbNullString
        End If
   End With

3. Navigate to the Selected Folder:
   

   Application.FollowHyperlink Me![ReqLink], , True

4. Any questions, don't hesitate to ask.

[vspsdca]

Thank you for your reply. Being a newbie I hope you wouldn't mind me asking you a few more questions regarding the code you have provided.

1. Do I replace my module code with the the code below or do i leave the module code as is? Do I put on this the On Click event of my browse button?

Execute the following code whereever appropriate:

Code: ( text )
Dim strFolderName As String
Dim result As Integer

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "View Folders For Hyperlink" 'Change if necessary
.AllowMultiSelect = False
.ButtonName = "Select Folder" 'Change if necessary
.InitialFileName = "C:\Windows\System32\" 'Change
.InitialView = msoFileDialogViewLargeIcons 'Change if necessary
result = .Show
If (result <> 0) Then
strFolderName = Trim(.SelectedItems.Item(1))
Me![ReqLink] = strFolderName
Else
Me![ReqLink] = vbNullString
End If
End With
Navigate to the Selected Folder:

2. Do I put the following code on the On Click event of my hyperlink textbox?

Code: ( text )
Application.FollowHyperlink Me![ReqLink], , True


3. A user ended up pasting a link on the Hyperlink textbox instead of using the browse for folder button, I noticed that when you click on the link the same error occurs. Is it because the code does not accept a link that did not come from the browse for folder button?

Thanks.

[ADezii]

In my opinion, your code is much too complicated for such a relatively simple task:

1. Create a Reference to the Microsoft Office XX.X Object Library
2. Execute the following code whereever appropriate:
   

   Dim strFolderName As String
   Dim result As Integer
    
   With Application.FileDialog(msoFileDialogFolderPicker)
     .Title = "View Folders For Hyperlink"     'Change if necessary
     .AllowMultiSelect = False        
     .ButtonName = "Select Folder"     'Change if necessary
     .InitialFileName = "C:\Windows\System32\"         'Change
     .InitialView = msoFileDialogViewLargeIcons        'Change if necessary
        result = .Show
        If (result <> 0) Then
          strFolderName = Trim(.SelectedItems.Item(1))
           Me![ReqLink] = strFolderName
        Else
          Me![ReqLink] = vbNullString
        End If
   End With

3. Navigate to the Selected Folder:
   

   Application.FollowHyperlink Me![ReqLink], , True

4. Any questions, don't hesitate to ask.

Just subscribing for now, will check back later when I have the time.

[ADezii]

Thank you for your reply. Being a newbie I hope you wouldn't mind me asking you a few more questions regarding the code you have provided.

1. Do I replace my module code with the the code below or do i leave the module code as is? Do I put on this the On Click event of my browse button?

Execute the following code whereever appropriate:

Code: ( text )
Dim strFolderName As String
Dim result As Integer

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "View Folders For Hyperlink" 'Change if necessary
.AllowMultiSelect = False
.ButtonName = "Select Folder" 'Change if necessary
.InitialFileName = "C:\Windows\System32\" 'Change
.InitialView = msoFileDialogViewLargeIcons 'Change if necessary
result = .Show
If (result <> 0) Then
strFolderName = Trim(.SelectedItems.Item(1))
Me![ReqLink] = strFolderName
Else
Me![ReqLink] = vbNullString
End If
End With
Navigate to the Selected Folder:

2. Do I put the following code on the On Click event of my hyperlink textbox?

Code: ( text )
Application.FollowHyperlink Me![ReqLink], , True


3. A user ended up pasting a link on the Hyperlink textbox instead of using the browse for folder button, I noticed that when you click on the link the same error occurs. Is it because the code does not accept a link that did not come from the browse for folder button?

1. Do I replace my module code with the the code below or do i leave the module code as is? Do I put on this the On Click event of my browse button?

There has been a slight code modification, replace your code with the following, and yes it can go in the Click() Event of your Browse Button.

Dim strFolderName As String
Dim result As Integer
 
With Application.FileDialog(msoFileDialogFolderPicker)
  .Title = "View Folders For Hyperlink"     'Change if necessary
  .AllowMultiSelect = False
  .ButtonName = "Select Folder"     'Change if necessary
  .InitialFileName = "C:\Windows\System32\"         'Change
  .InitialView = msoFileDialogViewLargeIcons        'Change if necessary
     result = .Show
     If (result <> 0) Then
       strFolderName = Trim(.SelectedItems.Item(1))
        Me![ReqLink] = strFolderName & "#" & strFolderName
     Else
       Me![ReqLink] = vbNullString
     End If
End With

2. Do I put the following code on the On Click event of my hyperlink textbox?

No code is needed to Navigate via the Hyperlink, as long as the Control Source for the Text Box (ReqLinq) is the HyperLink Data Type. This functionality is self contained within the Data Type, so a single Click will do the trick.

3. A user ended up pasting a link on the Hyperlink textbox instead of using the browse for folder button, I noticed that when you click on the link the same error occurs. Is it because the code does not accept a link that did not come from the browse for folder button?

You can manually enter a Hyperlink Path in any manner you wish, as long as it is valid, you can Navigate to it. You must, however, move off the Field then re-enter it for the Hyperlink to work.

[vspsdca]

Thanks so much!!!! It finally worked!

[ADezii]

Thanks so much!!!! It finally worked!

You are quite welcome.