时间戳

首页 > 解决方案 > 使用 vba 复制已打开的 IE 页面上的所有内容

excel - 使用 vba 复制已打开的 IE 页面上的所有内容

问题描述

我知道如何打开一个新的并复制所有内容。

而且我还知道如何引用已经打开的 IE 页面。

我正在努力从已经打开的 Internet Explorer 页面复制

请帮忙。

Function GetIE() As Object
'return an object for the open Internet Explorer window, or create new one
  For Each GetIE In CreateObject("Shell.Application").Windows() 'Loop to find
    If (Not GetIE Is Nothing) And GetIE.Name = "Internet Explorer" Then Exit For 'Found!
  Next GetIE
  If GetIE Is Nothing Then Set GetIE = CreateObject("InternetExplorer.Application") 'Create
  GetIE.Visible = True 'Make IE window visible

  ' (this is where the code fail) down

        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
        Range("A1").Select
        IE.Quit

End Function

基本上我需要这段代码：使用已经打开的 IE 窗口而不是 URL

Sub Test() 

    Dim IE As Object 

    Sheets("Sheet3").Select 
    Range("A1:A1000") = "" ' erase previous data
    Range("A1").Select 

    Set IE = CreateObject("InternetExplorer.Application") 
        With IE 
            .Visible = True 
            .Navigate "http://www.aarp.org/" ' should work for any URL
            Do Until .ReadyState = 4: DoEvents: Loop 
        End With 

        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False 
        Range("A1").Select 
        IE.Quit 

End Sub

标签： excelvbainternet-explorercopy-paste

解决方案

如果您只想获得一个打开的 IE 窗口，那么您可以使用GetObject()它。

如果您想获得特定的打开窗口（通过 URL），那么您可以执行以下操作：

Sub tester()
    Dim IE As Object

    Set IE = GetIE("http://www.aarp.org/")
    If Not IE Is Nothing Then
        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False 
        Range("A1").Select 
        IE.Quit 
    End If
End sub

使用这个：

'get a reference to an existing IE window, given a partial URL
Function GetIE(sLocation As String) As Object

    Dim objShell As Object, objShellWindows As Object, o As Object
    Dim sURL As String
    Dim retVal As Object

    Set retVal = Nothing
    Set objShell = CreateObject("Shell.Application")
    Set objShellWindows = objShell.Windows

    For Each o In objShellWindows
        sURL = ""
        On Error Resume Next  'because may not have a "document" property
        'Check the URL and if it's the one you want then
        ' assign the window object to the return value and exit the loop
        sURL = o.document.Location
        On Error GoTo 0
        If sURL Like sLocation & "*" Then
            Set retVal = o
            Exit For
        End If
    Next o

    Set GetIE = retVal

End Function

推荐阅读