Question

当编译器到达此处的第一行时，前面的代码行成功运行。

＆＃34; 91对象变量或未设置块变量＆＃34;

我想获取HTML表格数据。打开所需页面但无法获取表格数据。这有什么问题？

Sub tst()

'MsgBox
'Return

Dim username, password As String
Dim pages, rows, cols As Integer
Dim isbrowser As Boolean
Dim w, CODE, DESC, DOWNLOADS, x, url, temp, col, credentials
Dim html As Object

Sheets("Control").Select
credentials = Split(Sheets("Control").Cells(2, 2).Value, ":")
pages = Sheets("Control").Cells(2, 3).Value
isbrowser = Sheets("Control").Cells(2, 4).Value

username = credentials(0)
password = credentials(1)
rows = 2
cols = 6

' MsgBox username & "-" & password & "-" & pages & "-" & isbrowser
Sheets("Control").Cells(rows, cols).Value = "Downloading"
Sheets("Main").Cells.ClearContents
Const BetJBN As String = "login page url"

temp = col = w = CODE = DESC = DOWNLOADS = x = url = ""

On Error GoTo Err_Login

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = isbrowser

With IE
    .navigate BetJBN 'address of log in page
    Do While .busy: DoEvents: Loop
    Do While .readyState <> 4: DoEvents: Loop
    'this information is specific to the web page
    With .document.forms(0)
        .opername.Value = username
        .password.Value = password
        ''MsgBox "login"
        .submit
    End With
    MsgBox "Fetching start..."
    If pages = 0 Then
        url = "html table url"
        With IE
            .navigate url
            Do While .busy: DoEvents: Loop
            Do While .readyState <> 4: DoEvents: Loop
            With .document.forms(0)
                .Page.Value = username
                .searchmodel.Value = "buytimes"
                .op.Value = "search"
                ''MsgBox "Submit"
                .submit
            End With

            Set html = IE.document.getElementsByTagName("TABLE")(7)
            pages = Split(html.getElementsByTagName("TD")(0).innerText, "/")
            pages = Split(pages(1), " ")
            pages = pages(0)
            'MsgBox pages
            Sheets("Control").Select
            Sheets("Control").Cells(2, 3).Value = pages
            Set html = Nothing
            Sheets("Main").Cells.ClearContents
        End With
    End If
    'MsgBox pages

    x = 1
    For i = 1 To pages

        url = "html table url" & i

        'MsgBox url
        'MsgBox pages
        'Cells(x, 1).Value = "Page " & i
        'x = x + 1

        With IE
            .navigate url

            Do While .busy: DoEvents: Loop
            Do While .readyState <> 4: DoEvents: Loop

            Dim y As Integer
            y = -1

            Do Until y > IE.document.getElementsByTagName("TR").Length
                y = y + 1
                If IE.document.getElementsByTagName("TR")(y).className = "sptr2" Then

                    CODE = DESC = DOWNLOADS = ""
                    Set html = IE.document.getElementsByTagName("TR")(y)
                    CODE = html.getElementsByTagName("TD")(0).innerText
                    'DESC = html.getElementsByTagName("TD")(1).innerText
                    DESC = Format(Now, "DD-MMM-YY")
                    DOWNLOADS = html.getElementsByTagName("TD")(2).innerText
                    If CODE <> False Then
                        Sheets("Main").Cells(x, 1).Value = RBTCODE
                        Sheets("Main").Cells(x, 2).Value = DESC
                        Sheets("Main").Cells(x, 3).Value = DOWNLOADS
                        'MsgBox DOWNLOADS
                    Else
                        x = x - 1
                    End If
                    x = x + 1
                    Set html = Nothing
                End If
                On Error Resume Next
            Loop
        End With

    Next i

    MsgBox "Done with Fetching"
    Make_CSV (username)
    Sheets("Control").Select
    Sheets("Control").Cells(rows, cols).Value = "Done"
    IE.Quit
    Set IE = Nothing
    Sheets("Main").Cells.ClearContents
End With

Exit_Login:
Exit Sub

Err_Login:
MsgBox Err.Number & " " & Err.Description, vbOKOnly + vbCritical, "Error"
Resume Exit_Login

End Sub


Sub Make_CSV(user As String)
'
' CSV Macro
'
Dim sFile As String
Dim sBase As String
Dim sPath As String
Dim sDir As String

    sPath = "D:\"
    sBase = user & "_" & Format(Now, "YYYYMMDD")
    sFile = sBase & ".CSV"

    Sheets("Main").Select
    Sheets("Main").Copy Before:=Sheets(1)
    Sheets("Main (2)").Select
    Sheets("Main (2)").Name = sBase
    Range("B10").Select
    Sheets(sBase).Select
    sDir = "D:\"

    Sheets(sBase).Move
            ActiveWorkbook.SaveAs Filename:=sDir & ActiveSheet.Name & ".csv", FileFormat:=xlCSV, _
                                  CreateBackup:=False
            ActiveWindow.Close

    Columns("A:C").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("Control").Select

End Sub

Answer 1

这不是答案。真的指出那些看起来不对的......

通常，当您声明对象类型并且在为它们分配对象引用类型时不使用set时，会出现错误。还请在运行之前对代码进行调试编译。检查您的VBA编辑器设置并中断所有未处理的错误。

您当前的声明：

Dim username, password As String
Dim pages, rows, cols As Integer
Dim isbrowser As Boolean
Dim w, RBTCODE, DESC, DOWNLOADS, x, url, temp, col, credentials
Dim html As Object

username, pages, rows, w, RBTCODE, DESC, DOWNLOADS, x, url, temp, col, credentials are defined as variants in your code.您应该为每个数据类型单独提供正确的数据类型。

默认情况下，

row被声明为变体。我想知道你是如何设法在这一行中使用它并通过的。

Sheets("Control").Cells(rows, cols).Value = "Downloading"

默认情况下，

Pages被声明为变体。

pages = Sheets("Control").Cells(2, 3).Value
If pages = 0 Then

Answer 2

在访问对象之前添加Nothing的检查。在您的cas中元素＆＃39; TABLE＆＃39;可能不在页面上，当您尝试访问它时，您会收到错误91 Object Variable or with block variable not set。这意味着table为Nothing （未设置）。

Dim tables
Set tables = IE.document.getElementsByTagName("TABLE")

If tables Is Nothing Then
     MsgBox "No tables found", vbExclamation
Else
     If (tables.Length < 8) Then
        MsgBox "7th table can't be found. " & _
            "On the page there are only '" & tables.Length & "' tables.", vbExclamation
     Else
        Set html = tables(7)
     End If
End If

运行VBA宏时出现此错误

2 个答案: