title: VBA Open File From Hyperlink
body: <p>I wonder whether someone may be able to help me please.</p>
  
  <p>With some help along the way, I'm using the code below to perform the following:</p>
  
  <ul>
  <li>Extract files from a given path,</li>
  <li>inserting the filename into column <strong>C</strong>,</li>
  <li>The filepath into column <strong>D</strong>, and </li>
  <li><p>A hyperlink on each row in column <strong>B</strong>, which the user selects taking them to to the <strong>'Save As Dialog'</strong> allowing the user to save the file.</p>
  
  <pre><code>Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)
  
  Dim fName As String
  Dim Lastrow As Long
  
  On Error Resume Next
  For Each FileItem In SourceFolder.Files
  ' display file properties
      Cells(iRow, 3).Formula = FileItem.Name
      Cells(iRow, 4).Formula = FileItem.Path
      iRow = iRow + 1 ' next row number
  ''''''''
  '' As the progress bar is set for 0 to 100, treat
  '' the progress as a percentage when calculating
  ''''''''
      frm.prgStatus.Value = (xCur / xMax) * 100
  '' Add 1 to xCur ready for next file
      xCur = xCur + 1
      Next FileItem
  
      Range("C10").CurrentRegion.Select
      Selection.Sort Key1:=Range("C10"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
  
      With ActiveSheet
          Lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
          Lastrow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      End With
  
      If IncludeSubfolders Then
          For Each SubFolder In SourceFolder.SubFolders
              ListFilesInFolder SubFolder, True
              Next SubFolder
          End If
          Set FileItem = Nothing
          Set SourceFolder = Nothing
          Set FSO = Nothing
  
          For iRow = 10 To Lastrow
              Cells(iRow, 2).Formula = iRow - 9
              Cells(iRow, 4).Formula = FileItem.Path
              ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, 2), Address:="", _
              ScreenTip:=CStr(iRow - 9)
          Next
      End Sub
  </code></pre></li>
  </ul>
  
  <p>When the user clicks on the hyperlink, this is the 'Follow Hyperlink' code which runs allowing the user to save the file.</p>
  
  <p>*****UPDATED CODE*****</p>
  
  <pre><code>    Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
  
      Dim FSO
      Dim sFile As String
      Dim sDFolder As String
      Dim thiswb As Workbook ', wb As Workbook
  
      On Error GoTo CleanExit:
  
  'Disable events so the user doesn't see the codes selection
      Application.EnableEvents = False
  
  'Define workbooks so we don't lose scope while selecting sFile(thisworkbook = workbook were the code is located).
      Set thiswb = ThisWorkbook
  'Set wb = ActiveWorkbook ' This line was commented out because we no longer need to cope with 2 excel workbooks open at the same time.
  'Target.Range.Value is the selection of the Hyperlink Path. Due to the address of the Hyperlink being "" we just assign the value to a
  'temporary variable which is not used so the Click on event is still triggers
      temp = Target.Range.Value
  'Activate the wb, and attribute the File.Path located 1 column left of the Hyperlink/ActiveCell
      thiswb.Activate
      sFile = Cells(ActiveCell.Row, ActiveCell.Column + 2).Value
  
      If UCase$(Mid$(sFile, InStrRev(sFile, ".") + 1)) = "DOCX" Then
  
      Application.EnableEvents = True
          Select Case MsgBox("Do you wish to view the file before saving?", vbYesNoCancel Or vbQuestion, "Save or View?")
              Case vbCancel: Exit Sub
              Case vbYes:
                  With CreateObject("Word.Application")
                      .Visible = True
                      .Documents.Open sFile
                      .Activate
                  End With
                  Exit Sub
          End Select
      End If
  
  'Declare a variable as a FileDialog Object
      Dim fldr As FileDialog
  'Create a FileDialog object as a File Picker dialog box.
      Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
  'Allow only single selection on Folders
      fldr.AllowMultiSelect = False
  'Show Folder picker dialog box to user and wait for user action
      fldr.Show
  
  'Did the user cancel?
      If fldr.SelectedItems.Count &gt; 0 Then
  'Add the end slash of the path selected in the dialog box for the copy operation
          sDFolder = fldr.SelectedItems(1) &amp; "\"
  'FSO System object to copy the file
          Set FSO = CreateObject("Scripting.FileSystemObject")
  ' Copy File from (source = sFile), destination , (Overwrite True = replace file with the same name)
          FSO.CopyFile (sFile), sDFolder, True
          MsgBox "File Saved!"
      Else
  'Do anything you need to do if you didn't get a filename.
      MsgBox "You choose not to save the file!"
  
      End If
  ' Check if there's multiple excel workbooks open and close workbook that is not needed
  ' section commented out because the Hyperlinks no longer Open the selected file
  ' If Not thiswb.Name = wb.Name Then
  '     wb.Close
  ' End If
  CleanExit:
      If Err.Number &lt;&gt; 0 Then
          MsgBox "Error: " &amp; Err.Number &amp; vbCrLf &amp; Err.Description
      End If
  
      Application.EnableEvents = True
  End Sub
  </code></pre>
  
  <p>The code works fine, but I'm looking to change this a little, and what I've tried so far hasn't worked.</p>
  
  <p>What I'd like to do is change this by extracting the file extension, from the path in column <strong>D</strong>, and if the extension is .docx, I would like the user to be able to view the file rather than being taken straight to the 'Save As Dialog'.</p>
  
  <p>I'm a little out of my depth and as I say the changes I've made have not worked.</p>
  
  <p>I just wondered whether someone could possibly have a look at this please and offer some guidance on how I may go about achieving this.</p>
  
  <p>Many thanks and kind regards</p>
  
  <p>Chris</p>