CODEWITHSUNDEEP
excelvbaparsinginternet-explorerautomation
mccarthy995
mccarthy995

Reputation: 75

VBA Internet explorer script only works 50% of the time

I have a script on VBA that loads up a site, copies data & pastes it on a hidden page. It has worked before but I have to run it about 20 times to get it to do what I want it to do. The errors are very inconsistent and I am debating if I should proceed with this as I need at least a 95% success rate.

Majority of the time the data is not copied correctly & the page is blank, the script finishes with out error but nothing happens.

The other time the script fails is on Set ieTable = ieDoc.all.item -- Do While ieApp.Busy: DoEvents: Loop -- Set ieDoc = ieApp.Document

As you can see, just to be able to check where the errors are occurring I have plagued everything with message prompts.

Sub Pull_Data()

    'Kills ALL IE windows
    On Error GoTo Ignore:
    Call IE_Sledgehammer
    Ignore:

    Dim ieApp As InternetExplorer
    Dim ieDoc As Object
    Dim ieTable As Object
    Dim clip As DataObject
    Dim UserName As String, Password As String
    Dim SubmitButton
    Dim i As Integer

    'Create anew instance of ie
    Set ieApp = New InternetExplorer
    ieApp.Navigate "Intranet site I cannot share"

    'Debugging
    ieApp.Visible = True

    'When busy - wait
    On Error GoTo Skip_wait
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
    GoTo Login

    'Debugging
    Skip_wait:
    MsgBox ("You skipped the first wait")

    Login:
    '*****common error*****
    Set ieDoc = ieApp.Document
    Set SubmitButton = ieDoc.getElementsByTagName("input")

    'Login script
    With ieDoc.forms(0)
    If Err.Number = 424 Then
    GoTo skip_login

    .UserName.Value = "USERNAME"
    .Password.Value = "PASSWORD"
    SubmitButton(i).Click
    End If
    End With
    GoTo wait

    'Debugging
    skip_login:
    MsgBox ("You skipped the login")

    'When busy - wait
    wait:
    On Error GoTo Skip_waiting
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.ReadyState = READYSTATE_COMPLETE: DoEvents: Loop
    GoTo Copypaste

    Skip_waiting:
    MsgBox ("You skipped the second wait")

    'Copy&paste script
    Copypaste:
    Set clip = New DataObject
    Set ieTable = ieDoc.all.item
    clip.SetText "" & ieTable.outerHTML & ""
    clip.PutInClipboard
    Sheets("Raw Data").Range("E2").PasteSpecial "Unicode Text"

    'Kills all activeX/controls copied from ieDoc.all.item
    Sheets("Raw Data").DrawingObjects.Delete

    'Kills ALL IE windows
    On Error GoTo Ignored:
    Call IE_Sledgehammer
    Ignored:

    End Sub

I do know about the pull data from web option which was my goto on this stuff, but since our office has changed its security settings, its made that option impossible. Other than this, I cannot think of a way to pull data from a click of a button.

Is this option worth it? For anyone with experience with this, Can you tell me if this option is reliable? I cannot for the life of me work out why this is failing.

HTML:

<html><head>
    <title>
        Open Questions Summary
    </title>
    <link rel="stylesheet" href="/styles.css" type="text/css">
</head>
<body bgcolor="#FFFFFF">
    <table cellspacing="1" cellpadding="2" align="center" border="0" width="400">
        <tbody><tr>
            <td colspan="2">
                Customer Sector: 
                <form method="get" action="INTERNAL WORK SITE">
                    <select name="strCustomerType">
                        <option value="residential" selected="selected">Residential</option>
                        <option value="business">Business</option>
                    </select>
                    <input name="soobmit" value="Submit" type="submit">
                </form></table>

Upvotes: 0

Views: 106

Answers (1)

Zhi Lv
Zhi Lv

Reputation: 21383

From your code and description, it seems that you want to fill value into the textbox and handle the dropdownlist, I suggest you could refer to the following code, they all work well on my machine:

Sub LoginViaBrowser()
    Dim IE As Object

    Dim Dc_Usuario As String
    Dim Dc_Senha As String
    Dim Dc_URL As String

    Dim txtNam As Object, txtPwd As Object

    Dc_Usuario = "[email protected]"
    Dc_Senha = "pass"

    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .Navigate "https://www.solarmanpv.com/portal/LoginPage.aspx"

        While IE.ReadyState <> 4
            DoEvents
        Wend
        IE.Document.getElementById("uNam").Value = Dc_Usuario
        IE.Document.getElementById("uPwd").Value = Dc_Senha

        IE.Document.getElementById("Loginning").Click

    End With
    Set IE = Nothing
End Sub

Handle dropdown list:

Public Sub ClickTest()

    Dim  ie As Object, evtChange As Object

    Dim item As Object

    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate2 "<the website url>"

        While .Busy Or .readyState <> 4: DoEvents: Wend

        Set evtChange = .Document.createEvent("HTMLEvents")
        evtChange.initEvent "change", True, False

        'get the select element. Please note the index, it is starting from 0.
        Set item = ie.Document.getElementsByTagName("select")(0)

        expCcy = "EUR"

        'Set the Expression Currency
        For Each o In item 'Sets Expression Currency
            If o.Value = expCcy Then
                o.Selected = True
                o.dispatchEvent evtChange
                Exit For
            End If
        Next        
    End With
End Sub

More detail information, please check the following threads: Textbox related thread and DropDownList related thread.

Upvotes: 1

Related Questions