VBA follow hyperlink and open file from hyperlink directory

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
888
Office Version
  1. 365
Platform
  1. Windows
I have read a few forums online about this but nothing quite matches what I am looking to do.

What I require is as soon as the word "Closed" is entered on a certain row a Macro is triggered (this part I have)

What I want that Macro to do is go to the very first cell in that row (.Range(Cells(Selection.Row, -21), Cells(Selection.Row, -21)).Select),
open the hyperlink in that cell (which will open a folder) and then open a file in that folder.

Example of File Name: CC3074

Customer Concern Log.xlsm
A
1976CC3074
CC Database


1661886797656.png


Once the excel file is open I need that file activated and checked if cell O15 says TRUE or FALSE
if FALSE there will be a message box stating "CC Report incomplete. Please complete the report before closing out"
or something to that effect.

I can figure out the majority of this but what I have trouble with is opening the file using the hyperlink directory in VBA and activating the file in order to check cell O15

Help with this would be greatly appreciated!
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Hi willow1985,

Try this as your worksheet change event...

VBA Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngFind As Range
    Dim strHyperlinkFormula As String
    
    strHyperlinkFormula = "A" 'Column containing the HYPERLINK formula. Change to suit.

    On Error Resume Next
        Set rngFind = Rows(Target.Row).Find(What:=CStr("Closed"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    On Error GoTo 0
    If Not rngFind Is Nothing Then
        Application.ScreenUpdating = False
            If Range(strHyperlinkFormula & Target.Row).HasFormula And InStr(StrConv(ActiveSheet.Range(strHyperlinkFormula & Target.Row).Formula, vbUpperCase), "HYPERLINK") > 0 Then
                Call Module1.ChkCCRptStatus(strHyperlinkFormula & Target.Row)
            End If
        Application.ScreenUpdating = True
    End If

End Sub

...and this macro in a module called Module1:

VBA Code:
Option Explicit
Sub ChkCCRptStatus(strAddr As String)

    Dim strPath As String, strFileExtn As String, strFile As String
    
    'The following assumes (change to suit):
    '1. The Hyperlink formula only holds the source file directory
    '2. There's only one file in the directory with an extension derived from the 'strFileExtn' variable
    '3. Cell O15 of sheet 'Sheet1' within the 'wb' workbook has a boolean value stating if the CC Report is complete or not
    strPath = Split(Range(strAddr).Formula, Chr(34))(1) 'Chr(34) is the " sign (double quotes)
    strPath = IIf(Right(strPath, 1) <> "\", strPath & "\", strPath)
    strFileExtn = "xls"
    strFile = Dir(strPath & "*." & strFileExtn)
    If Len(strFile) = 0 Then
        MsgBox "There are no files with a """ & strFileExtn & """ extension in """ & strPath & """.", vbExclamation
        Exit Sub
    End If
    If GetValueFromClosedWorkbook(CStr(strPath & strFile), "Sheet1", "O15") = False Then
        MsgBox "CC Report is incomplete." & vbNewLine & "Please complete the report before closing out.", vbExclamation
    End If
    
End Sub
'https://www.codevba.com/excel/closed_workbook_get_value.htm#.YygFGnZBy70
'Trebor76 Sep 2022 - Also works if the workbook is open
Public Function GetValueFromClosedWorkbook(FileName As String, Sheet As String, CellAddress As String)

    '?GetValueFromClosedWorkbook("C:\temp\excel partners.xlsx", "Excel", "B2")
    Dim strFilePath As String, strFileNameShort As String, strArg As String
    
    strFilePath = Left(FileName, InStrRev(FileName, "\"))
    strFileNameShort = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
    strArg = "'" & strFilePath & "[" & strFileNameShort & "]" & Sheet & "'!" & Range(CellAddress).Range("A1").Address(, , xlR1C1)
    GetValueFromClosedWorkbook = ExecuteExcel4Macro(strArg)
        
End Function

Regards,

Robert
 
Upvote 0

Forum statistics

Threads
1,214,987
Messages
6,122,618
Members
449,092
Latest member
amyap

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top