如何在vba中将excel宏指定给命令按钮?

时间:2014-08-27 08:58:09

标签: excel vba excel-vba

我在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。

谢谢。

0 个答案:

没有答案