Я не очень знаком с 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