Excel中的自动Internet Explorer可以搜索站点上的多个项目

时间:2018-02-07 15:42:35

标签: excel vba excel-vba ie-automation

我正在使用excel 2013,其中包含一列包含许可证号的工作表。

宏需要遍历每个要在网页上搜索的单元格。 搜索后,它会从搜索结果页面中获取一些详细信息,并将其放入许可证编号旁边的单元格中。

我遇到的问题是,并非所有的许可证号都会被发现导致网站抛出错误而不会进入导致代码失败的结果页面。

我需要一种方法来跳过引发网页错误的许可证号码并继续下一个条目。

另一个令人头疼的问题是,插入到单元格中的结果来自表格格式,因此它会使单元格变得庞大并抛弃工作簿格式。有没有办法从搜索结果中获取特定的详细信息,或者确保将其放入" unwrapped"格式?

重新制作宏的详细信息。

网站需要您创建免费的用户名和密码,但创建后应保存一个cookie,因此代码不包含登录部分。

网页搜索位置(登录后):https://aca3.accela.com/MILARA/GeneralProperty/PropertyLookUp.aspx?isLicensee=Y&TabName=APO

错误页面:https://aca3.accela.com/MILARA/Error.aspx?ErrorId=2d09a60802d2455b8fbf1b86e45033d2

    Sub SearchPage()

    Dim IE As Object
    Dim search As Variant
    Dim button As Variant
    Dim LR As Integer
    Dim var As String
    Dim var1 As Object
    Dim CurrentWindow As HTMLWindowProxy

    LR = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To LR
    var = Cells(x, 1).Value

    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True

    With IE
    .Visible = True
    .navigate "https://aca3.accela.com/MILARA/GeneralProperty/PropertyLookUp.aspx?isLicensee=Y&TabName=APO"

    While Not .readyState = READYSTATE_COMPLETE
    Wend
    End With

            'Wait some to time for loading the page

    While IE.Busy
    DoEvents
    Wend

    Application.Wait (Now + TimeValue("0:00:02"))
            'this is where it puts the number from the cell into the search box
'below is the text search box and the cell containing the ID    IE.document.getElementById("ctl00_PlaceHolderMain_refLicenseeSearchForm_txtLicenseNumber").Value = var
            'Here we are clicking on search Button
    IE.document.getElementById("ctl00_PlaceHolderMain_btnNewSearch").Click

            'wait for page to load
    Application.Wait (Now + TimeValue("0:00:02"))
    While IE.Busy
    DoEvents
    Wend


            'grabs results from search and places it in cell next to searched id

    Set var1 = IE.document.getElementById("ctl00_PlaceHolderMain_upGeneralInfo")
    Cells(x, 2).Value = var1.innerText

    IE.Quit
    Set IE = Nothing

    Next x
    End Sub

1 个答案:

答案 0 :(得分:0)

Sub SearchPage()

Dim IE As Object
Dim search As Variant
Dim button As Variant
Dim LR As Integer
Dim var As String
Dim var1 As Object
Dim var2 As Object
Dim var3 As Object
Dim var4 As Object
Dim var5 As Object
Dim var6 As Object

Dim CurrentWindow As HTMLWindowProxy
 On Error Resume Next
LR = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To LR
var = Cells(x, 1).Value

Set IE = CreateObject("internetexplorer.application")
IE.Visible = False

With IE
.Visible = False

.navigate "https://aca3.accela.com/MILARA/GeneralProperty/PropertyLookUp.aspx?isLicensee=Y&TabName=APO"

While Not .readyState = READYSTATE_COMPLETE
Wend
End With

        'Wait some to time for loading the page

While IE.Busy
DoEvents
Wend

Application.Wait (Now + TimeValue("0:00:02"))
        'this is where it puts the number from the cell into the search box
IE.document.getElementById("ctl00_PlaceHolderMain_refLicenseeSearchForm_txtLicenseNumber").Value = var
        'Here we are clicking on search Button
IE.document.getElementById("ctl00_PlaceHolderMain_btnNewSearch").Click

        'wait for page to load
Application.Wait (Now + TimeValue("0:00:01"))
While IE.Busy
DoEvents
Wend




                'grabs table
'Set var1 = IE.document.getElementById("ctl00_PlaceHolderMain_upGeneralInfo")
'Cells(x, 2).Value = var1.innerText

                'grabs name
              Application.Wait (Now + TimeValue("0:00:01"))

Set var2 = IE.document.getElementById("ctl00_PlaceHolderMain_licenseeGeneralInfo_lblContactName_value")
Cells(x, 3).Value = var2.innerText

        Application.Wait (Now + TimeValue("0:00:01"))

                'grabs Issue date
Set var3 = IE.document.getElementById("ctl00_PlaceHolderMain_licenseeGeneralInfo_lblLicenseIssueDate_value")
Cells(x, 4).Value = var3.innerText

        Application.Wait (Now + TimeValue("0:00:01"))

                'grabs expiration date
Set var4 = IE.document.getElementById("ctl00_PlaceHolderMain_licenseeGeneralInfo_lblExpirationDate_value")
Cells(x, 5).Value = var4.innerText

        Application.Wait (Now + TimeValue("0:00:01"))

                'license status
Set var5 = IE.document.getElementById("ctl00_PlaceHolderMain_licenseeGeneralInfo_lblBusinessName2_value")
Cells(x, 6).Value = var5.innerText

 Application.Wait (Now + TimeValue("0:00:01"))

                'grab url
'Set var6 = IE.LocationURL
'Cells(x, 7).Value = var6.innerText


IE.Quit
Set IE = Nothing
Next x

'Application.Wait (Now + TimeValue("0:00:02"))

MsgBox ("Verification Import Complete")



End Sub