Hyperlinks.follow code to timeout

[pd2004]

Hello,

I would like to find simple(hopefully) code to allow my code to timeout (or resume next) if the hyperlink I am trying to follow doesn't work. If I just paste the link into internet explorer, it will return a generic page saying the URL cannot be found. I can deal with that easily, but if I add the hyperlink to my excel worksheet, and then follow it, it will hang indefinitely if it cannot find the URL.

Also, this method does take a long time (for links that do work). About 8 seconds to load the page. Any suggestions to speed up are also greatly appreciated.

Thank you in advance!

Pat


ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"

http://someaddress"

Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

 

[pd2004]

Hi,

I would like to simplify the question. Within VBA, if I call a procedure and it hangs up (in this case, opening/importing a querytable), it will currently hang indefinitely. I need code that will stop the procedure and go to the next. I have tried do while and other looping with timers, but they don't work ( timer only is evaluated when the procedure finishes and the loops).

Any help is greatly appreciated.

Thank you,

Pat

Sub Test_5_1()
Dim TestTime As Double

newHour1 = Hour(Now())
newMinute1 = Minute(Now())
newSecond1 = Second(Now()) + 10
waitTime1 = TimeSerial(newHour1, newMinute1, newSecond1)

Do While TimeSerial(Hour(Now()), Minute(Now()), Second(Now())) < waitTime1

'some procedure here... this one is a querytable import

With ActiveSheet.QueryTables.Add(Connection:="URL;

http://www.yahoo.com",

_
Destination:=Range("$A$2"))
.Name = "

http://www.yahoo"

.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

'procedure completes




GoTo 200


Loop


200

End Sub