Hyperlinks Open Files

[How_Do_I]

Hello, I've been looking on YouTube for videos of how to open hyperlinks in xl 365 without the xl Security Notice popping up. Can anyone point me in the right direction please.

 

[Jeffrey Mahoney]

I never liked hyperlinks. They change on me and I get security questions just like you. This method is somewhat more complicated, but it is easier for the end user

I have a daily tracker that allows me to add files and folders to a column so I can double click on them to open them instead of using hyperlinks.

Here is an example of one of my cells that I double click to open the file

Q:\Folder1\Project Register\RptAnalysis - CurrentWorkingFile.xlsm, password, WRPW

This opens the file that has a Write Reserved Password

This opens a file or a folder

'Providing a password assumes that you want to open a workbook
'PWType = "PW" then Normal password to open
'PWType = "WRPW then WriteResPassword; WriteReserved = Read Only until Password is entered
'Parms = command line parameters passed through shell
'  /r = open in Read Only
'  /e = Prevents startup screen and new workbook
'  /s = Safe Mode
'  /x = Starts Excel in new thread
'PathFile can be url; any string with 'http'
'PathFile can be a folder; cannot contain file extension
'PathFile can be a non Excel file; Word, PDF ...
Sub OpenPathFile(PathFile As String, Optional PW As String, Optional PWType As String, Optional Parms As String)

  Dim PF As Variant
  Dim WBBool As Boolean
  Dim Ext As String
  Dim WB As Workbook
  Dim LastPeriod As Long
  Dim Q As String
  Dim aStr As String
  
  If PathFile = "" Then Exit Sub
  LastPeriod = InStrRev(PathFile, ".")
  If LastPeriod > 0 Then Ext = Mid(PathFile, LastPeriod, 100)
  
  Application.StatusBar = "Opening: " & PathFile
  DoEvents
  On Error Resume Next
  If PW <> "" Or Ext = ".xlsm" Or Ext = ".xlsx" Or Ext = ".xls" Or Ext = ".xlsb" Then   'Excel Workbook
    If PW <> "" Then
      Select Case UCase(PWType)
        Case "PW"
          Set WB = Workbooks.Open(PathFile, UpdateLinks:=True, Password:=PW)
        Case "WRPW"
          Set WB = Workbooks.Open(PathFile, UpdateLinks:=True, WriteResPassword:=PW)
      End Select
    ElseIf Parms = "" Then
      Set WB = Workbooks.Open(PathFile)
    ElseIf Parms <> "" Then               'Parms like /x /e /s cannot be used with passwords
      Q = Chr(34)
      aStr = " " & Q & PathFile & Q & " " & Parms
      Application.DisplayAlerts = False
      Call Shell("Excel.exe" & aStr, vbNormalFocus)
    End If
  
  'URL
  ElseIf InStr(PathFile, "http") Then
    ThisWorkbook.FollowHyperlink PathFile
  
  'Non Excel File
  ElseIf InStr(PathFile, ":") And Len(PathFile) - InStrRev(PathFile, ".") < 6 Then
    PF = PathFile & vbNullString
    CreateObject("Shell.Application").Open PF
      
  'Normal Folder or network server folder; no file extension
  ElseIf (InStr(PathFile, ":\") Or InStr(PathFile, "\\")) And Len(PathFile) - InStrRev(PathFile, ".") > 5 Then
    Call Shell("Explorer.exe" & " " & PathFile, vbNormalFocus)
  End If
  On Error GoTo 0
  Application.OnTime Now + TimeValue("00:00:03"), "TimerEnd", Schedule:=True

End Sub

Sub TimerEnd()
Application.StatusBar = False
End Sub

'This code needs to be added to your SHEET MODULE. Edit this string: Set R = Range("ChckLst_Tbl[Hyperlink]") to be whatever range you have in your sheet

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Range
    Dim R As Range
    Dim Cel As Range
    Dim HyperlinkStr As String
    Dim Path As String
    Dim FileName As String
    Dim Pars As Variant
    Dim PCnt As Long
    Dim PW As String
    Dim PWT As String
    Dim Parms As String
    

    Set R = Range("ChckLst_Tbl[Hyperlink]")
    Set i = Intersect(R, Target)
    If Not i Is Nothing Then                  'Hyperlink column
      HyperlinkStr = i.Value
      If HyperlinkStr <> "" Then
        Cancel = True
        Pars = Split(HyperlinkStr, ",")
        On Error Resume Next
        HyperlinkStr = Trim(Pars(0))
        PW = Trim(Pars(1))
        PWT = Trim(Pars(2))
        Parms = Trim(Pars(3))
        On Error GoTo 0
        
        OpenPathFile HyperlinkStr, PW, PWT, Parms
        
      End If
    End If

End Sub