Excel VBA 打开超链接 - 一开始很慢？

Question

我已经在线复制了一些 VBA 代码，可以在 Internet Explorer 中打开 excel 中的一组 link 到多个选项卡。问题是，尤其是在速度较慢的计算机上，IE 需要一点时间才能打开，因此计算机只会加载另一个 IE window 所以你最终会在一个 IE window 中说 3 links ]，另一个 7，它偶尔也会漏掉一个 link。

因此，我通过在加载的每个 link 之间加入 2 秒的中断来减慢代码速度。这已经解决了问题 - 一个 IE 会话，所有 links 加载，现在这个问题是等待似乎过多。我想要的可能是延迟加载前 2-3 links，然后剩余的可以尽快加载（假设所有 links 确实最终加载，没有另一个 IE 会话也在加载..)

我该怎么做？ - 提前谢谢你。

无论如何这是代码：忽略开头和结尾的位，它只是突出显示各种 link 并隐藏一些列...:[=13=]

Sub Convert2links()
'
' Convert2links Macro
'

'
Columns("G:L").Select
    Range("G7").Activate
    Selection.EntireColumn.Hidden = False
    Range("J8:J28").Select
    Selection.Copy
    Range("K8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A8").Select
    Selection.End(xlDown).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    Application.CutCopyMode = False

Dim Rng As Range
Dim WorkRng As Range
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
For Each Rng In WorkRng
    Application.ActiveSheet.Hyperlinks.Add Rng, Rng.Value
Next


    Dim xHyperlink As Hyperlink
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    For Each xHyperlink In WorkRng.Hyperlinks
        xHyperlink.Follow
        Application.Wait (Now + TimeValue("00:00:02"))
    Next
    Columns("H:K").Select
    Range("H7").Activate
    Selection.EntireColumn.Hidden = True
    Range("A8").Select
End Sub

Answer 1

这是 Ken Puls 的一些修改代码，用于检查 IE 是否打开

Public Function IEIsOpen() As Boolean

 'IMPORTANT:  Requires reference to Microsoft Internet Controls!!
    'Set in Tools --> References --> Microsoft Internet Controls

    Dim shellWins As SHDocVw.ShellWindows
    Dim explorer As SHDocVw.InternetExplorer

    Set shellWins = New SHDocVw.ShellWindows

    For Each explorer In shellWins
        If explorer.Name = "Internet Explorer" Then
            IEIsOpen = True
            Exit For
        End If
    Next

    Set shellWins = Nothing
    Set explorer = Nothing

End Function

然后你可以这样做

For Each xHyperlink In WorkRng.Hyperlinks
    xHyperlink.Follow
    Do Until IEIsOpen
        DoEvents
    Loop
Next

它将打开第一个，然后在打开 IE 之前不会打开任何其他。

更新

你最好在那里检查一下以防止死循环

Dim dtStart As Date

dtStart = Now
For Each xHyperlink In WorkRng.Hyperlinks
    xHyperlink.Follow
    Do Until IEIsOpen Or Now - dtStart > TimeSerial(0, 0, 5)
        DoEvents
    Loop
Next xHyperlink

现在它将等待 IE 或五秒，以先到者为准。

Excel VBA 打开超链接 - 一开始很慢？

Excel VBA to open hyperlinks - slowly initially?

excel

internet-explorer

vba

excel-2010