This pops up a message if the hyperlink fails then continues with the next link.
Sub Save_Hyperlinks_As()
Dim cell As Range, wb As Workbook
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("B1:B10")
On Error Resume Next
cell.Hyperlinks(1).follow
On Error GoTo 0
If ActiveWorkbook Is ThisWorkbook Then
MsgBox cell.Address(0, 0) & vbLf & cell.Value, vbInformation, "Could Not Open Link"
Else
With Workbooks("reportviewer")
Application.DisplayAlerts = False
.saveas Filename:= _
"D:\personal\10046733\Warehousing\ERT Reports\" & _
cell.Offset(, 1).Value & ".xls", FileFormat:=56, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
.Close
Application.DisplayAlerts = True
End With
End If
Next cell
End Sub
Bookmarks