Question

问题：当我将其与关闭的文件一起使用并且在桌面上使用时，代码可以正常工作。但它不适用于已经打开的excel文件。

我将Set xlWbk = Workbooks.Open更改为Set xlWbk = GetObject，但这不起作用。

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

在您的示例中，工作表变量“xlSht”分配有当前工作表，因此与当前打开的工作簿中的工作表一起分配。试试这个：

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

Answer 2

这是Queston的解决方案。我发现它＆＃34;使用Access 2010 VBA列出所有打开的Excel工作簿＆＃34;

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

Access VBA中的Excel对象 - Web Scraper - 打开excel文件或参考已打开的Excel文件

2 个答案: