Excel VBA function to return a working link to paperwork

Question

I'm trying to error-proof a spreadsheet at work. One thing we've had trouble with is people copy-pasting links then just changing the RMA number. This would work in theory if all the links had the same extension, but some are .xls and some are .xlsx.

I've made it so that when a cell in the RMA column is changed, the cell offset 53 to the right of it gets a hyperlink generated by the public function GetCRRLink() inserted into it.

Private Sub Worksheet_Change(ByVal ChangedCells As Range)
'Some code omitted here, RMA is defined
    If Not Intersect(CurrentCell, RMA) Is Nothing Then
        Set CurrentCell.Offset(0, 53).Formula = GetCRRLink(CurrentCell.Value)
    End If
'Some code omitted here
End Sub

'Meanwhile, in Module 1
Public Function GetCRRLink(RMA As String) As Hyperlink
    On Error Resume Next
    Dim TryLink As Hyperlink
    Set TryLink.TextToDisplay = "CRR Form"
    Set TryLink.Address = "redacted" & RMA & ".xls"
    TryLink.Follow
    If Err.Number = 0 Then
        GetCRRLink = TryLink
        Exit Function
    End If
    Err.Clear
    Set TryLink.Address = "redacted" & RMA & ".xlsx"
    TryLink.Follow
    If Err.Number = 0 Then
        GetCRRLink = TryLink
        Exit Function
    End If
    Set TryLink.TextToDisplay = "Error"
    GetCRRLink = TryLink
End Function

When trying to set the TextToDisplay or Address properties of TryLink, I get "Compile error: Wrong number of arguments or invalid property assignment".

You cannot change the signature of the `Worksheet_Change` event handler (unless this is in a regular module and you're calling it from the sheet module event handler?) More significant - there is no such thing as a free-floating hyperlink object: you can only create one by adding it to a sheet' s `Hyperlinks` collection. So what you're trying to do here can't work the way you have it. — Tim Williams, Sep 28 '19 at 23:13
Where are these documents stored? If in a fileshare you can use `Dir()` to check if the file exists. If in a HTTP location you can use an XMLHTTP call to see if there's a matching resource at that URL. — Tim Williams, Sep 28 '19 at 23:19
@TimWilliams So what if I make the `Hyperlink` object, then add it to the sheet's `Hyperlinks` object as the first or last element? Also with regards to your second comment, does `xmlhttp` work in excel vba? That sounds like it might be the best option. — Jolnar Industries, Sep 30 '19 at 12:25
@TimWilliams they are stored on a sharepoint server on the work intranet. — Jolnar Industries, Sep 30 '19 at 20:49
Post on validating HTTP url's from VBA: https://stackoverflow.com/questions/44813295/how-to-do-image-url-validation-in-excel-2016/44813655#44813655 — Tim Williams, Sep 30 '19 at 21:23
@TimWilliams I have it working now, what is the signature of an event handler, and why do you say I can't change it? — Jolnar Industries, Oct 03 '19 at 19:13

Dschuli · Answer 1 · 2019-09-28T18:05:06.867

0

TextToDisplay and Address are String properties. So just remove the Set, which is only used for object assignments. This should do the trick.

TryLink.TextToDisplay = "CRR Form"
TryLink.Address = "redacted" & RMA & ".xls"
...

By the way, you will need the Set when assigning TryLink as the function result.

edited Sep 28 '19 at 18:05

answered Sep 28 '19 at 17:33

Dschuli

309
3
10

This will not work either... You cannot create a Hyperlink except by adding to the sheet's Hyperlinks collection, so you can't return a Hyperlink object from a function if it doesn't already exist on the sheet... – Tim Williams Sep 28 '19 at 23:16

score 0 · Accepted Answer · answered Oct 03 '19 at 19:20

Thanks TimWilliams!

Private Sub Worksheet_Change(ByVal ChangedCells As Range)
'Some code omitted here, RMARange is defined, events disabled
    For Each CurrentCell In ChangedCells.Cells
        If Not Intersect(CurrentCell, RMARange) Is Nothing Then
            If CurrentCell.Value = 0 Or CurrentCell.Value = "" Then
                Call CurrentCell.Offset(0, 53).Hyperlinks.Delete
                CurrentCell.Offset(0, 53).Formula = ""
            Else
                LinkAddress = GetCRRLink(CurrentCell)
                Call ThisSheet.Hyperlinks.Add(CurrentCell.Offset(0, 53), LinkAddress, "", "", CurrentCell.Value)
            End If
        End If
    Next
'Some code omitted here, events enabled
End Sub

'Meanwhile in Module 1...
Public Function GetCRRLink(ReadCell As Range) As String
    Dim TryUrl As String
    Dim RMA As String
    RMA = ReadCell.Value
    TryUrl = "redacted" & RMA & ".xls"
    If HttpTest(TryUrl) = "OK" Then
        GetCRRLink = TryUrl
        Exit Function
    End If
    TryUrl = "" & RMA & ".xlsx"
    If HttpTest(TryUrl) = "OK" Then
        GetCRRLink = TryUrl
        Exit Function
    End If
    GetCRRLink = "Error"
End Function

'Thanks TimWilliams!
Public Function HttpTest(TryUrl As String) As String
    Dim FileChecker As Object
    Set FileChecker = CreateObject("WinHttp.WinHttpRequest.5.1")
    Call FileChecker.SetAutoLogonPolicy(0)
    With FileChecker
        .Open "GET", TryUrl, False
        .Send
        HttpTest = .statusText
    End With
End Function

Excel VBA function to return a working link to paperwork

2 Answers2