VBA: Get Redirect URLs & Title Tags In Excel
The code below takes the URLs in column A, loads the page in internet explorer and returns the redirect URL in column B with the title tag in column C. This is useful to help detect broken links, incorrect landing pages and improper redirects. To use this code please refer to my post on How To Install VBA Macros.
Sub GetRedirectUrls()
Dim i, j, FirstRowOfData, SkipRows As Long
Dim myIE As Object
Dim URLColumn, RedirectColumn, TitleTagColumn As String
'Edit the settings below for your document
URLColumn = "A"
RedirectColumn = "B"
TitleTagColumn = "C"
FirstRowOfData = 2
SkipRows = 0
'Finds the last row of data
Range(URLColumn & "1048576").Select
Selection.End(xlUp).Select
j = ActiveCell.Row 'Opens IE and Loads the URL from the first row of data
For i = FirstRowOfData To j
Set myIE = CreateObject("InternetExplorer.Application")
'Comment out below to hide IE window
myIE.Visible = True
'Waits for page to load
myIE.Navigate Range(URLColumn & i).Text
Do While myIE.busy
Loop
'Writes redirect URL and Title tag to columns specified above
Range(RedirectColumn & i).Value = myIE.Document.URL
Range(TitleTagColumn & i).Value = myIE.Document.Title
'Quits IE
myIE.Quit
Set myIE = Nothing
i = i + SkipRows
Next i
End Sub
If this code has helped you, or you have additional modifications to prevent stack overflow errors (when running for long periods of time), please leave a comment below.
Hi Jon,
This macro is great.
Unfortunately, the output is a bit inconsistent; about 25% of the cells in RedirectColumn end up blank even if each one has a valid redirect page.
The issue is also non-repeatable; re-running the macro produces a different set of blank cells.
I don’t mean to complain, as this is a very helpful start. Just curious if you have any ideas.
Thanks!
Hey JG,
This is one of the few non-spam comments I get on here!
I have noticed a similar issue with this and I am pretty sure it has to do with the “Do While myIE.busy” portion of the script. I tried eliminating the use for IE as the browser but have found myself stuck as well.
Other things I have tried is adding a wait time to the function, which reduces the number of blank cells but has not completely removed the issue. I know this response is not exactly timely (due to the spam filtering) but have you had any luck since your last posting?
-Jon