Excel VBA打开超链接-开始时缓慢吗?

时间:2018-08-01 13:14:38

标签: excel vba excel-vba internet-explorer excel-2010

我已经在线复制了一些VBA代码,该代码将excel中的一组链接打开到Internet Explorer的多个选项卡中。问题是,尤其是在速度较慢的计算机上,IE会花一点时间才能打开,因此计算机仅加载了另一个IE窗口,因此您最终在一个IE窗口中说了3个链接,而在另一个IE窗口中说了7个链接,有时也会完全错过了链接。

因此,我通过在每个加载的链接之间添加2秒的间隔来减慢代码的速度。这就解决了问题-一个IE会话,所有链接都已加载,现在的问题是等待似乎过多。我想要的是延迟加载前2-3个链接,然后其余链接可以尽快加载(假设所有链接确实加载完毕,而另一个IE会话也没有加载。)

我该怎么做? -谢谢你。

无论如何,这里是代码:忽略开头和结尾的部分,它只是突出显示了各种链接并隐藏了一些列...:

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

1 个答案:

答案 0 :(得分: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或5秒,以先到者为准。