没有错误,但在VBA执行后excel上也没有输出
这是我正在使用的代码。宏上没有错误,但excel工作表上也没有输出。 我正试图从表中获取所有股票的数据没有错误,但在VBA执行后excel上也没有输出,excel,vba,import-from-excel,Excel,Vba,Import From Excel,这是我正在使用的代码。宏上没有错误,但excel工作表上也没有输出。 我正试图从表中获取所有股票的数据 Sub sqylogin() On Error Resume Next Dim ie, objShell, Wnd As Object Set objShell = CreateObject("Shell.Application") Application.Calculation = xlManual ieopen = True For Each Wnd In objShell.Windows
Sub sqylogin()
On Error Resume Next
Dim ie, objShell, Wnd As Object
Set objShell = CreateObject("Shell.Application")
Application.Calculation = xlManual
ieopen = True
For Each Wnd In objShell.Windows
If Right(Wnd.Name, 17) = "Internet Explorer" Then
Set ie = Wnd
ieopen = False
Exit For
End If
Next Wnd
If ieopen Then Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
p = "https://www.pse.com.ph/stockMarket/marketInfo-marketActivity.html?tab=1&indexName=All%20Shares"
ie.navigate (p): Application.Wait (Now + #12:00:59 AM#)
Set divelements = ie.Document.getElementsbytagname("div")
Cells(1, 1) = Now: c = 2
For Each divelement In divelements
If divelement.ID = "ext-gen291" Then
For j = 0 To 300
For i = 0 To 8
Cells(c + j, i + 1).Value = divelement.Children(j).Children(0).Children(0).Children(0).Children(i).innertext
Next i
Next j
End If
Next divelement
Set ie = Nothing
Application.Calculation = xlCalculationAutomatic
End Sub
父div中的表是通过ajax调用动态加载的,因此需要某种等待条件来确保它们存在。我根据存在的子表的数量显示等待条件,并使用剪贴板将子表复制粘贴到工作表中
Option Explicit
Public Sub GetMarketActivity()
Dim ie As SHDocVw.InternetExplorer, clipboard As Object
Set ie = New SHDocVw.InternetExplorer
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim t As Date
Const MAX_WAIT_SEC As Long = 360
With ie
.Visible = True
.Navigate2 "https://www.pse.com.ph/stockMarket/marketInfo-marketActivity.html?tab=1&indexName=All%20Shares"
Do
DoEvents
Loop While .Busy Or .readyState <> READYSTATE_COMPLETE
t = Timer
Do
DoEvents
If Timer - t > MAX_WAIT_SEC Then Exit Sub
Loop Until .document.querySelectorAll(".x-grid3-row-table").Length > 1 '<wait for more than one record (Table)
Dim tables As Object, i As Long, headers()
Set tables = .document.querySelectorAll(".x-grid3-row-table")
headers = Array("Record", "Symbol", "Last trade date", "Last trade price", "Outstanding shares")
For i = 0 To tables.Length - 1
clipboard.SetText tables.item(i).outerHTML
clipboard.PutInClipboard
With ActiveSheet
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(i + 2, 1).PasteSpecial
End With
Next
.Quit
End With
End Sub
删除错误继续下一步,再试一次Hi QHarr,我尝试了你的代码它正在工作,尽管在粘贴10-20行后我遇到了一个错误。范围类的特殊方法失败。谢谢。嗨,恐怕我在测试中运行得很好,所以我会看看今晚是否可以复制。