[Galdino]

Hi all.

I have an excel file with some cells containing Hypertextual URL links.

These links are opened by a macro but sometimes the internet site is slow because it is down or in overload and excel crashes.

I try pressing esc button but it doesn't work, the screen become white and everything stops.

I was arguing if there is a way to unblock excel in these cases or maybe a code that I can insert in the macro so that it stops the loop after 10 seconds.

Thank you

[Advertisements]

This should get you close to what you want:

Sub Close_Slow_Hyperlink()

Dim newHour, newMinute, newSecond, waitTime, nowTime
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)

Do Until nowTime >= waitTime

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now())
nowTime = TimeSerial(newHour, newMinute, newSecond)

Range("B6").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Application.WindowState = xlNormal

If ActiveWorkbook.Name <> "Book2" Then Exit Sub

Loop

End Sub


____________________________________________________________________


What you have to do is substitute where I've got cell "B6" for the cell containing your hyperlink, and (very important) change where I've got "Book2" for the workbook containing the calling macro WITHOUT THE .XLS EXTENSION


Pressing Ctrl + Break usually stops a macro in its tracks, though this operation can be switched off via code, also it doesn't work if Excel isn't the active application.

Have fun!!!!!!

[Jonesey]

This should get you close to what you want:

Sub Close_Slow_Hyperlink()

Dim newHour, newMinute, newSecond, waitTime, nowTime
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)

Do Until nowTime >= waitTime

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now())
nowTime = TimeSerial(newHour, newMinute, newSecond)

Range("B6").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Application.WindowState = xlNormal

If ActiveWorkbook.Name <> "Book2" Then Exit Sub

Loop

End Sub


____________________________________________________________________


What you have to do is substitute where I've got cell "B6" for the cell containing your hyperlink, and (very important) change where I've got "Book2" for the workbook containing the calling macro WITHOUT THE .XLS EXTENSION


Pressing Ctrl + Break usually stops a macro in its tracks, though this operation can be switched off via code, also it doesn't work if Excel isn't the active application.

Have fun!!!!!!

[Galdino]

how to join this?

Sub OpenLink()
Dim rCell As Range
On Error Resume Next
Application.DisplayAlerts = False
With Selection
For Each rCell In Selection.Cells
ActiveWorkbook.FollowHyperlink _
Address:=rCell.Value, _
NewWindow:=True
Next rCell
End With
End Sub


I put the first or after?

meanwhile thanks.

[Jonesey]

Try this:

Sub Close_Slow_Hyperlink()

Dim newHour, newMinute, newSecond, waitTime, nowTime, rCell
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)

Do Until nowTime >= waitTime

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now())
nowTime = TimeSerial(newHour, newMinute, newSecond)

With Selection
For Each rCell In Selection.Cells

Selection.Hyperlinks(1).Follow NewWindow:=True, AddHistory:=True
Application.WindowState = xlNormal

If ActiveWorkbook.Name <> "Book2" Then Exit Sub

Next rCell
End With

Loop

End Sub

______________________________________________________________


I haven't tested this, you may or may not need the With....End With statement.

And you might have to add the "Address:=rCell.Value" condition to the Hyperlinks.Follow statement - my version of Excel didn't show this.

[Galdino]

I resolved to adding DoEvents on the macro code
Thanks to all
Bye