我正在尝试登录一个网站,并使用一组关键字搜索该网站并捕获结果。我正在尝试使用VBA实现的所有功能
我点击了以下链接,但在本节中失败,并出现错误。
错误:需要运行时错误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