Windows 10 Internet Explorer не работает со старым кодом VBA

Question

Я написал код в VBA пару лет назад, чтобы открыть веб-сайт в IE и заполнить текстовые поля данными из файла Excel. К сожалению, я использую Windows 10 сейчас, и эта программа больше не работает. Он открывает сайт без проблем, но не может перенести данные в текстовые поля. Он просто открывает сайт и останавливается (данные не вводятся).

Программа по-прежнему работает в IE в Windows 7, без каких-либо проблем. Я пробовал несколько ноутбуков с Windows 10, и проблема повторяется.

Честно говоря, я не знаю, как это исправить.

DoEvents
WebAddress = "CONFIDENTIAL URL HERE" & WebID & "&t=" 

        Dim IE As Object

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


  Set IE = CreateObject("InternetExplorer.Application")

  IE.Navigate WebAddress
  IE.Visible = True
  While IE.busy
    DoEvents  'wait until IE is done loading page.
  Wend

  Application.Wait (Now + TimeSerial(0, 0, 4))

  IE.Document.All("Response_123").Value = ThisWorkbook.Sheets("Sheet1").Range("B5")

Последняя строка кода должна передавать данные из файла excel в текстовое поле в Internet Explorer, однако ничего не происходит, и текстовое поле остается пустым. Нужно ли что-либо менять в своем коде для учетной записи Windows 10 IE?

Answer 1

Вы видите, что ваш код не был написан эффективным способом.Для альтернативного подхода вы можете обратиться к приведенному ниже примеру, который отлично работает с Windows 10.

Dim IE As Object

Sub demo()
    Application.ScreenUpdating = False

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate "C:\Users\Administrator\Desktop\sample.html"


    While IE.Busy
        DoEvents
    Wend

    wait 1
    IE.Document.getElementById("firstname").Value = ThisWorkbook.Sheets("Sheet1").Range("A1")
    wait 1
    IE.Document.getElementById("lastname").Value = ThisWorkbook.Sheets("Sheet1").Range("A2")
    wait 1
    IE.Document.getElementById("submit_btn").Click

    IE.Quit
    Set IE = Nothing

    Application.ScreenUpdating = True
End Sub

Private Sub wait(seconds As Long)
    Dim endTime As Date
    endTime = DateAdd("s", seconds, Now())
    Do While Now() < endTime
        DoEvents
    Loop

End Sub

Вывод:

Если мы говорим о размещенном выше коде, вы можете попытаться поставить точку останова в этой строке и отладить код.Проверьте, какое значение содержится в ячейке B5, и проверьте, успешно ли выполняется эта строка.Для тестирования попробуйте назначить статическое значение этому текстовому полю.