我在Excel工作簿中编写了一个宏,该宏被分配给一个按钮。我现在在VBA中创建一个新表单,并尝试将相同的代码分配给命令按钮。
这是一个用于浏览指定URL并将信息提取到excel工作簿的代码。它适用于前10条记录,但后来,它在“For Each TRelement In TRelements
”代码行中给出了错误“权限被拒绝”。
请帮我解决这个问题。
Sub CommandButton1_Click()
Dim URL As String
Dim HTMLDoc As Object
Dim IE As Object
Dim TRelements As Object
Dim TRelement As Object
Dim InputElements As Object
Dim InputElement As Object
Dim r As Long
Dim i As Long
Dim offSet As Integer
Dim maxOffSet As Integer
URL = "https://www.gebiz.gov.sg/scripts/main.do?sourceLocation=openarea&select=rfiId"
Sheet1.Cells.ClearContents
'Sheet1.Range("A:F").ClearContents
'Set IE = New InternetExplorer
offSet = 0
r = 0
k = 0
Set IE = CreateObject("InternetExplorer.Application")
'While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend
'Set HTMLdoc = IE.Document
'With IE
IE.navigate URL
IE.Visible = True
'Wait for page to load
'While IE.readyState <> READYSTATE_COMPLETE
'DoEvents
'Wend
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Set InputElements = IE.document.getElementsByTagName("input")
For Each InputElement In InputElements
If InputElement.getAttribute("name") = "strBtnLast" Then
maxOffSet = CInt(Split(Split(InputElement.getAttribute("onclick"), "Navigator(")(1), ")")(0))
End If
Next
While offSet <= maxOffSet
offSet = offSet + 10
Set TRelements = IE.document.getElementsByTagName("tr")
For Each TRelement In TRelements
If TRelement.className = "row_even" Or TRelement.className = "row_odd" Or TRelement.className = "header_subone" Then
i = 0
For Each Child In TRelement.ChildNodes
Sheet1.Range("A1").offSet(r, i).Value = Child.innerText
i = i + 1
Next
r = r + 1
End If
Next
If offSet <= 10 Then
Sheet1.Rows(1).Delete
Sheet1.Rows(1).Delete
r = r - 2
End If
If offSet > 10 Then
Sheet1.Rows(offSet - 8).Delete
Sheet1.Rows(offSet - 8).Delete
Sheet1.Rows(offSet - 8).Delete
r = r - 3
End If
IE.document.parentWindow.execScript "submitHTMLTableNavigator(" + CStr(offSet) + ");"
'While .readyState <> READYSTATE_COMPLETE
'DoEvents
'Wend
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Sheet1.Range("A:F").WrapText = False
IE.Quit
Wend
'End With
End Sub
我正在使用Excel 2010。
谢谢。