Hyperlink - Workbook Open Event

  • Hi all,
    Hope some one can share some insight.


    I have an expanding number of Workbooks that include hyperlinks to common reference Workbooks, all of which have autorun macros in the WorkbookOpen Event. However this event is not trigured by a hyperlink, as a work around i have used the WindowActivate event to run initialisation code normally called by the auto open routines.
    This is not very efficient as the code is called every time the user selects a given Window. Does anyone have a better solution???

  • You could try this;


    Private Sub Workbook_Activate()
    If WorkbookIsOpen("Test") = True Then
    MsgBox "Workbook Is Open"
    Else
    MsgBox "Run Something"
    End If


    End Sub


    Private Function WorkbookIsOpen(wb) As Boolean
    Dim w As Workbook
    On Error Resume Next
    Set w = Workbooks(wb)
    If Err = 0 Then
    WorkbookIsOpen = True
    Else: WorkbookIsOpen = False
    End If
    End Function



    I place a hyperlink in a workbook and called the test workbook and if it was already opened it fired as true, so you could set the Workbook_Activate code the same as the Workbook_Open code and set the WorkbookIsOpen to true where you need to.


    HTH


    Bruce

  • Insomniac,


    Don't like them for opening Workbooks because of this problem. Great for linking to documents, PDF's, images etc but not workbooks.


    Are the workbooks your linking to to open in a fixed location ? If so get rid of the hyperlink and use an object like a transparent control of some sort and overlay it on the background text. You can then hard code (1.) the filepath & name to open on that control, this allows the workbookopen events to trigger (your macros). If your workbooks are randomly located and may move between sub directories within a master directory the you can still code the directory to search (2.) and the file name to open as per attached examples. You'll need to read between the lines and extract what works for you, It's a little messy as it has evolved over a period of time and I haven't caught up with the housekeeping :(


    (1.) Sub EquipSummary_Open()
    Application.ScreenUpdating = False
    On Error GoTo HandleAnyErrors
    Dim MY_PATH As String
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Msg = "This will open an Equipment Summary Sheet. Do you want to proceed?"
    Style = vbYesNo + vbInformation + vbDefaultButton1
    Title = "WSG-eQuote"
    Help = "DEMO.HLP"
    Ctxt = 1000
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbNo Then
    ElseIf ViaModem = True Then
    GoTo 20
    ElseIf GetHardwareProfile = 1 Then
    On Error GoTo error
    ChDir NETWORK_PATH & "MARKETING\QUOTE PACKAGE\Templates"
    Workbooks.Open FileName:=NETWORK_PATH & "MARKETING\QUOTE PACKAGE\Templates\Equip Summary Sheet.xlt", UpdateLinks:=0 'check your _ options for update links
    Application.DisplayAlerts = False
    Exit Sub
    error:
    ChDir LOCAL_PATH & "MARKETING\QUOTE PACKAGE\Templates"
    Workbooks.Open FileName:=LOCAL_PATH & "MARKETING\QUOTE PACKAGE\Templates\Equip Summary Sheet.xlt", UpdateLinks:=0
    Application.DisplayAlerts = False
    Else
    20 ChDir LOCAL_PATH & "MARKETING\QUOTE PACKAGE\Templates"
    Workbooks.Open FileName:=LOCAL_PATH & "MARKETING\QUOTE PACKAGE\Templates\Equip Summary Sheet.xlt", UpdateLinks:=0
    Application.DisplayAlerts = False
    End If
    Exit Sub
    HandleAnyErrors:
    MsgBox ("Program cannot be found."), vbOKOnly, "ERROR"
    End Sub



    (2.) Sub DRAWINGS_FIND()
    On Error Resume Next
    If ViaModem = True Then
    GoTo 20
    If GetHardwareProfile = 1 Then
    With Application.FileSearch
    .NewSearch
    .LookIn = "P:\MARKETING\Drawings\"
    .SearchSubFolders = True
    'I'm searching for and opening a drawing based on the value of a cell
    .FileName = "a" & ActiveCell.value & ".dwg"
    .MatchAllWordForms = True
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
    For I = 1 To .FoundFiles.Count
    'Then using a hyperlink, but you can substitute appropiate code to open once the file is found
    Application.Range("A200").value = .FoundFiles(I)
    ActiveWorkbook.FollowHyperlink Address:=Application.Range("A200").value, NewWindow:=True
    Next I
    Exit Sub
    End If
    End With
    Else
    20 With Application.FileSearch
    .NewSearch
    .LookIn = "C:\MARKETING\Drawings\"
    .SearchSubFolders = True
    .FileName = "a" & ActiveCell.value & ".dwg"
    .MatchAllWordForms = True
    .FileType = msoFileTypeAllFiles
    If .Execute() > 0 Then
    For I = 1 To .FoundFiles.Count
    Application.Range("A200").value = .FoundFiles(I)
    ActiveWorkbook.FollowHyperlink Address:=Application.Range("A200").value, NewWindow:=True
    Next I
    Exit Sub
    End If
    End With
    End If
    End If
    MsgBox ("Program not found."), vbInformation, "WSG-eQuote"
    End Sub



    Regards
    Tony Watermann

  • Hi Insomniac


    Try the code below. You could also store a 'flag' in a cell on a hidden sheet.




    If you use the End Statement anywhere in the Workbook it will destroy the Project level Boolean variable before the Workbook closes. In this case you can use a cell on a hidden sheet as the flag and use the Before_Close to clear it.

  • Thanks all for replies,


    Good to see others have explored the problem.


    In response to queries:


    I use hyperlinks because
    1. they are convenient
    2. are easy to add with VBA
    3. my filenames change
    4. my file locations may change


    I have an addin which checks the top row of all my workbooks for relevant hyperlinks and updates them when the file is opened, it is unnoticed by the user.


    I do this to avoid lengthy chunks of code in all the workbooks.


    I already have a hidden sheet which stores a boolean for my initialisation code to check wether it has run itself.


    The WorkbookActivate solution may be a better test though.


    Once again thanks for the response.