Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88150

Excel VBA unable to update hyperlink address

$
0
0

I'm not very familiar with VBA and am stuck on the last step of finishing my code! What this code does is scan every sheet in the workbook for cells with hyperlinks, and then it goes into the hyperlink and prepends a URL onto it. Everything is working - the last Debug.Print here is properly printing out the correct URL. But then it just hangs and gets stuck on "link.Address = currentAddress". No warning, no error message, it just hangs and does nothing until I press Enter, at which point it highlights that line yellow.

I'm at a loss for how currentAddress can print just fine, but can't be set to the link's address? And it only happens for certain links. Here is one that WORKS:

http://localhost:8000/link?owner=lencompass&name=Create%20a%20JIRA%20ticket%20here!&worksheet=test%20sheet&test=true&destination=https://jira01.corp.censored.com:8443/secure/CreateIssue.jspa%3Fpid=14071%26issuetype=1

Here is one that does NOT WORK:

http://localhost:8000/link?owner=lencompass&name=Core%20Dash%20-%20Performance%20by%20Recipient%20Company%20%26%20Function(Last%2012%20months)&worksheet=test%20sheet&test=true&destination=https://censored.corp.censored.com/accounts/1337/insights/880%3FmultiPeers=309694%2C1586%2C10667%2C1441%2C1009%2C1337%2C1035%2C1028%2C3185%2C1815218%2C96622

These links work when I use them in the browser so I know they are valid links.

Here is my entire VBA script:

Sub trackify_links()

    Dim I As Integer

    ' Loop through each sheet in this workbook
    For I = 1 To ActiveWorkbook.Worksheets.Count

        ' loop through each cell in this sheet
        Dim rwIndex As Long
        Dim colIndex As Long

        Dim maxRow As Long

        maxRow = Worksheets(I).Cells(Worksheets(I).Rows.Count, 4).End(xlUp).Row

        Worksheets("For IAs").Range("E16") = "Looping over "& maxRow & " rows in sheet: "& Worksheets(I).Name

        For rwIndex = 1 To maxRow

            ' only loop up to the max filled-in column on this row
            Dim maxColumn As Long
            maxColumn = Worksheets(I).Cells(rwIndex, Worksheets(I).Columns.Count).End(xlToLeft).Column
            For colIndex = 1 To maxColumn

                Dim linkIndex As Long
                Dim link As Hyperlink

                For linkIndex = 1 To Worksheets(I).Cells(rwIndex, colIndex).Hyperlinks.Count 

                    Set link = Worksheets(I).Cells(rwIndex, colIndex).Hyperlinks(linkIndex)

                    ' only trackify a link if it isn't already
                    If Left(link.Address, 30) <> "http://localhost:8000/link?" Then

                        ' this is a QA check - i noticed people putting their local machine paths as links here which won't work for anyone else. Output a list of weird links as a warning
                        If Left(link.Address, 3) = "../" Or Left(link.Address, 2) = "./" Then
                            Worksheets("For IAs").Range("E19") = "The link in cell ("& Col_Letter(colIndex) & rwIndex & ") in worksheet "& Worksheets(I).Name & " looks like it's a local path. These links will not work and have not been trackified - consider changing them."
                        Else

                            Dim currentAddress As String

                            ' in order for the tracking link to properly redirect, there needs to be an "http://" or "https://" protocol at the beginning
                            If LCase(Left(link.Address, 7)) <> "http://" And LCase(Left(link.Address, 8)) <> "https://" Then
                                currentAddress = "https://"& link.Address
                            Else
                                currentAddress = link.Address
                            End If
                            ' replace special characters with hex code so the link is not incorrectly parsed
                            currentAddress = ConvertToHex(currentAddress) 


                            Dim extraParameters As String
                            extraParameters = "owner="& ConvertToHex("lencompass")                                                        ' indicate this link belongs to lencompass
                            extraParameters = extraParameters & "&name="& ConvertToHex(link.TextToDisplay)                 ' set the name of this link to the excel link's text"
                            extraParameters = extraParameters & "&worksheet="& ConvertToHex(Worksheets(I).Name)        ' indicate where in the workbook this link was clicked from (if tab format stays the same it basically will tell what kind of person is clicking)
                            If Worksheets("For IAs").Range("E3") <> "No" Then _
                                extraParameters = extraParameters & "&test=true"' indicate this is a testing link if appropriate

                            ' here we wrap the cell's current link into the tracking link, and customize it with some info about where in the workbook this link was clicked
                            Debug.Print ("currentaddress: "& currentAddress)
                            currentAddress = "http://localhost:8000/link?"& extraParameters & "&destination="& currentAddress
                            Debug.Print (currentAddress)
                            link.Address = currentAddress
                        End If

                    End If

                Next linkIndex

            Next colIndex

        Next rwIndex

    Next I

End Sub

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

Function ConvertToHex(str As String) As String
    ConvertToHex = Replace(Replace(Replace(Replace(str, "?", "%3F"), "&", "%26"), "", "%20"), """", "%22")
End Function

Viewing all articles
Browse latest Browse all 88150

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>