VBA Internet Explorer скрипт работает только 50% времени - PullRequest
Новая
       12

VBA Internet Explorer скрипт работает только 50% времени

0 голосов
/ 10 октября 2019

У меня есть скрипт на VBA, который загружает сайт, копирует данные и вставляет их на скрытую страницу. Он работал раньше, но мне нужно запустить его примерно 20 раз, чтобы заставить его делать то, что я хочу. Ошибки очень противоречивы, и я спорю, стоит ли мне продолжать это делать, так как мне нужен как минимум 95% успех.

В большинстве случаев данные копируются неправильно, а страница пуста, сценарий завершается без ошибок, но ничего не происходит.

В другой раз, когда сценарий завершается неудачей, находится на Set ieTable = ieDoc.all.item - Делать при ieApp.Busy: DoEvents: Loop - Установить ieDoc = ieApp.Document

Как вы можете видеть, просто чтобы иметь возможность проверить, где происходят ошибки, я заразил все сообщениями с подсказками. 

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

Я знаю о параметре извлечения данных из Интернета, который был моим переходомна этот материал, но так как наш офис изменил свои настройки безопасности, он сделал этот вариант невозможным. Кроме этого, я не могу придумать способ получить данные одним нажатием кнопки.

Стоит ли этот вариант? Для тех, кто имеет опыт работы с этим, можете ли вы сказать мне, если этот вариант надежен? Я не могу на всю жизнь понять, почему это не удается.

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>

1 Ответ

1 голос
/ 10 октября 2019

Из вашего кода и описания кажется, что вы хотите ввести значение в текстовое поле и обработать выпадающий список. Я предлагаю вам обратиться к следующему коду, все они хорошо работают на моем компьютере: 

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 = "user@email.com"
    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

Раскрывающийся список дескриптора: 

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

Более подробная информация, пожалуйста, проверьте следующие темы: Тема, связанная с текстовым полем и Тема, связанная с DropDownList .

...