Access VBA中的Excel对象-Web抓取工具-打开excel文件或参考已打开的Excel文件

Question

Question: The Code works when I use it with a file that is closed and on the desktop. But it will not work with an excel file, which is already open.

I changed Set xlWbk = Workbooks.Open to Set xlWbk = GetObject, but this did not work.

Sub MSAcessGoogleWebScraper()

'Tools/References...
'Microsoft HTML Object Library
'Microsoft Internet Controls
'Microsoft Excel 16.0 Object Library

' Enter some ticker symbols in row 1 of the excel worksheet
' Save file to your desktop
'---------------------------------------------------

' Open Excel Workbook

Dim xlApp As Excel.Application
Dim xlWbk As Excel.Workbook
Dim xlSht As Excel.Worksheet

Set xlApp = Excel.Application
Set xlWbk = Workbooks.Open("C:\Users\XXXXXX\Desktop\Book1.xlsx")
Set xlSht = Worksheets(1)

xlApp.Visible = True
xlWbk.Activate
xlSht.Activate

' Start WebScraper

Dim IE As New InternetExplorer
Dim DOC As HTMLDocument
Dim Row_Company As Range
Dim Row_Price As Range

Range("A1").Select

Do Until ActiveCell.Value = ""

    IE.navigate " https://www.google.com/finance?q= " & ActiveCell.Value
    IE.Visible = False

    Do
    DoEvents
    Loop Until IE.ReadyState = READYSTATE_COMPLETE

    Set DOC = IE.Document
    Set Row_Company = ActiveCell.Offset(0, 1)
    Set Row_Price = ActiveCell.Offset(0, 2)

    Row_Company = DOC.getElementsByClassName("appbar-snippet-primary")(0).innerText
    Row_Price = DOC.getElementsByClassName("pr")(0).innerText

    ActiveCell.Offset(1, 0).Select

Loop

IE.Quit

End Sub

Answer 1

In your example, the worksheet variable "xlSht" is assigned with the current worksheet and therefore with the worksheet from the workbook that is currently opened. Try this instead:

Set xlApp = Excel.Application
Set xlWbk = Workbooks.Open("C:\Users\XXXXXX\Desktop\Book1.xlsx")
Set xlSht = xlWbk.Worksheets(1)

Answer 2

This is the solution to the Queston. I found it "Using Access 2010 VBA list all open Excel Workbooks"

Option Compare Database    
Option Explicit    

Sub MSAcessGoogleWebScraper()    

    'Tools/References...    
    'Microsoft HTML Object Library    
    'Microsoft Internet Controls    
    'Microsoft Excel 16.0 Object Library    

    ' Enter some ticker symbols in row 1 of the excel worksheet    
    ' Save file to your desktop    
    '---------------------------------------------------    

    ' Open Excel Workbook    

    Dim xlApp As Excel.Application    
    Dim xlWbk As Excel.Workbook    
    Dim xlSht As Excel.Worksheet    

    Set xlApp = GetObject(, "Excel.Application")    
    Set xlWbk = xlApp.Workbooks(1)    
    Set xlSht = xlWbk.Worksheets(1)    

    xlApp.Visible = True    
    xlWbk.Activate    
    xlSht.Activate    

    ' Start WebScraper    

    Dim IE As New InternetExplorer    
    Dim DOC As HTMLDocument    
    Dim Row_Company As Range    
    Dim Row_Price As Range    

    xlApp.Range("A1").Select    

    Do Until xlApp.ActiveCell.Value = ""    

        IE.navigate " https://www.google.com/finance?q= " & xlApp.ActiveCell.Value    
        IE.Visible = False    

        Do    
            DoEvents    
        Loop Until IE.ReadyState = READYSTATE_COMPLETE    

        Set DOC = IE.Document    
        Set Row_Company = xlApp.ActiveCell.Offset(0, 1)    
        Set Row_Price = xlApp.ActiveCell.Offset(0, 2)    

        Row_Company = DOC.getElementsByClassName("appbar-snippet-primary")(0).innerText    
        Row_Price = DOC.getElementsByClassName("pr")(0).innerText    

        xlApp.ActiveCell.Offset(1, 0).Select    

    Loop    

    IE.Quit    

End Sub