Невозможно обновить адрес гиперссылки - PullRequest
0 голосов
/ 27 февраля 2020

Я не очень знаком с VBA и застрял на последнем шаге завершения моего кода! Этот код сканирует каждый лист рабочей книги на наличие ячеек с гиперссылками, а затем переходит в гиперссылку и добавляет к ней URL-адрес. Все работает - последний Debug.Print здесь правильно печатает правильный URL. Но тогда он просто зависает и застревает на "link.Address = currentAddress". Никаких предупреждений, никаких сообщений об ошибках, он просто зависает и ничего не делает, пока я не нажму Enter, после чего эта строка подсвечивает желтую строку.

Я в растерянности из-за того, что currentAddress может печатать просто отлично, но не может быть установлен адрес ссылки? И это происходит только для определенных ссылок. Вот тот, который работает:

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

Вот тот, который не работает:

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

Эти ссылки работают, когда я использую их в браузере, поэтому я знаю, что они являются действительными ссылками.

Вот весь мой сценарий VBA:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...