在网站上搜索关键字

时间:2020-06-26 09:39:58

标签: excel vba

我正在尝试登录一个网站,并使用一组关键字搜索该网站并捕获结果。我正在尝试使用VBA实现的所有功能

我点击了以下链接,但在本节中失败,并出现错误。

Excel macro to search a website with excel data and extract specific results and then loop for next value

错误:需要运行时错误424对象

With Sheet2.QueryTables.Add( _
            Connection:="URL;http://xyz123.com/manager/view/User.aspx?action=" & strSearch & "&safe=active", _
            Destination:=Sheet2.Range("A1"))   ' Change this destination to Sheet2

代码如下:

我无法提供确切的网址,因为它是机密的。我提供了一个假人。

Sub login_to_groups()

    Const Url$ = "https://xyz123.com/siteminderagent/forms/login.fcc?TARGET=http://xyz123.com/manager/"

    Dim UserName As String, Password As String, LoginData As Worksheet
    Set LoginData = ThisWorkbook.Worksheets("Sheet1")
    UserName = LoginData.Cells(1, "B").Value
    Password = LoginData.Cells(2, "B").Value

    Dim ie As Object
    Set ie = CreateObject("InternetExplorer.Application")

    With ie

        .navigate Url
        ieBusy ie
        .Visible = True

        Dim oLogin As Object, oPassword As Object
        Set oLogin = .document.getElementsByName("USER")(0)
        Set oPassword = .document.getElementsByName("PASSWORD")(0)

        oLogin.Value = Email
        oPassword.Value = Password
        .document.forms(0).submit

    End With

End Sub

Sub ieBusy(ie As Object)
    Do While ie.Busy Or ie.readyState < 4
        DoEvents
    Loop
End Sub

Sub get_account_owner()
    Dim i As Integer
    Dim ABN As String
    For i = 2 To Sheet1.UsedRange.Rows.Count
        ABN = Sheet1.Cells(i, 2)
        Sheet1.Cells(i, 3) = URL_Get_ABN_Query(ABN)
    Next i
End Sub

Function URL_Get_ABN_Query(strSearch As String) As String   ' Change it from a Sub to a Function that returns the desired string
    ' strSearch = Range("a1") ' This is now passed as a parameter into the Function
    Dim entityRange As Range
    With Sheet2.QueryTables.Add( _
            Connection:="URL;http://xyz123.com/manager/view/User.aspx?action=" & strSearch & "&safe=active", _
            Destination:=Sheet2.Range("A1"))   ' Change this destination to Sheet2

        .BackgroundQuery = True
        .TablesOnlyFromHTML = True
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    ' Find the Range that has "Entity Type:"
    Set entityRange = Sheet2.UsedRange.Find("Supervisor/Contact")

    ' Then return the value of the cell to its' right
    
    URL_Get_ABN_Query = entityRange.Offset(0, 1).Value2

    ' Clear Sheet2 for the next run
    Sheet2.UsedRange.Delete

End Function

0 个答案:

没有答案