VBA使用.click在id上的getelment保持加载状态

Question

我正在使用Excel中的VBA创建脚本，以在Internet Explorer中打开一个网页，并从Excel推送数据以提交该页面并移至下一个页面。

除了通过单击删除按钮推送数据以替换单元图像文件：The remove button

及其代码如下：

<button type="submit" id="edit-field-building-autocad-img-und-0-remove-button" name="field_building_autocad_img_und_0_remove_button" value="remove" class="btn btn-danger form-submit icon-before ajax-processed ladda-button button btn-sm delete-file-btn" data-style="zoom-in" data-spinner-color="#000" data-spinner-lines="12"><span class="ladda-label"><span class="icon glyphicon glyphicon-trash" aria-hidden="true"></span>  remove</span><span class="ladda-spinner"></span></button>

我将按钮ID与.click一起使用

单击按钮后，它看起来应该像这样：afer clicking the remove button

但是它只是继续加载，看起来像这样：Keep loading

我的代码：

Sub PushDataMoh（）

Dim IE  As Object
Dim doc As HTMLDocument
Dim wsb As Worksheet: Set wsb = ThisWorkbook.Sheets("sheet2")
Dim pn     'page number
Dim mypage 'The default page
Dim RowCount
Dim UnitNum
Dim LevelNum


For RowCount = 2 To 4
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    pn = wsb.Range("A" & RowCount).Value
    mypage = "https://" & pn & "/edit/320189/320225"
    IE.Navigate mypage

    Do While IE.Busy Or IE.ReadyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop

    Set doc = IE.Document
    Set submit = doc.getElementById("edit-submit")
    Set del = doc.getElementById("edit-field-building-autocad-img-und-0-remove-button")

    UnitNum = doc.getElementById("edit-field-unit-no-und-0-value").Value   'Get unit number
    LevelNum = doc.getElementById("edit-field-floor-no-und-0-value").Value  'Get Level number
    NameCheck = "The Unit number is " & UnitNum & " the level number is " & LevelNum
    Debug.Print NameCheck

    doc.getElementById("edit-field-north-side-und-0-value").Value = wsb.Range("E" & RowCount).Value     'Get North
    doc.getElementById("edit-field-east-side-und-0-value").Value = wsb.Range("F" & RowCount).Value      'Get East
    doc.getElementById("edit-field-south-side-und-0-value").Value = wsb.Range("G" & RowCount).Value     'Get South
    doc.getElementById("edit-field-west-side-und-0-value").Value = wsb.Range("H" & RowCount).Value      'Get West

    del.Click

    Do While IE.Busy Or IE.ReadyState <> 4
        Application.Wait DateAdd("s", 10, Now)
    Loop

    Set choseFile = doc.getElementById("edit-field-building-autocad-img-und-0-upload")
    Set upload = doc.getElementById("edit-field-building-autocad-img-und-0-upload-button")

    choseFile.Click
    upload.Click

    Do While IE.Busy Or IE.ReadyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop

    submit.Click

    Do While IE.Busy Or IE.ReadyState <> 4
        Application.Wait DateAdd("s", 1, Now)
    Loop
    'RowCount.EntireRow.Interior.ColorIndex = 6

    'IE.Quit

Next

结束子

HTML代码如下：

<div class="file-widget form-managed-file clearfix col-md-9 files-cont"><input type="hidden" name="field_building_autocad_img[und][0][fid]" value="820983">
<input type="hidden" name="field_building_autocad_img[und][0][display]" value="1">
<span class="file"><img class="file-icon" alt="Image icon" title="image/png" src="/modules/file/icons/image-x-generic.png"> <a href="https://subdivision-services.housing.gov.sa/sites/default/files/1577728621274522778-test_part1-11_3.png" type="image/png; length=508614">1577728621274522778-test_part1-11_3.png</a></span>  <span class="file-size badge">496.69 كيلوبايت</span><button type="submit" id="edit-field-building-autocad-img-und-0-remove-button" name="field_building_autocad_img_und_0_remove_button" value="حذف" class="btn btn-danger form-submit icon-before ajax-processed ladda-button button btn-sm delete-file-btn" data-style="zoom-in" data-spinner-color="#000" data-spinner-lines="12"><span class="ladda-label"><span class="icon glyphicon glyphicon-trash" aria-hidden="true"></span>
 حذف</span><span class="ladda-spinner"></span></button>
</div>

Answer 1

您可以尝试参考此示例，可能有助于正确调度事件。

Option Explicit

'It works with Excel 32 bit and Excel 64 bit
#If Win64 Then
  'For 64 bit systems
  Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
  'For 32 bit systems
 ' Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub test()

Dim url As String
Dim browser As Object
Dim btn As Object

  url = "https://example.com"

  Set browser = CreateObject("internetexplorer.application")
  browser.Visible = True
  browser.navigate url
  Do Until browser.readyState = 4: DoEvents: Loop

  Set btn = browser.document.getElementById("btn1")
  btn.Focus

  'btn.Click

  Call TriggerEvent(browser.document, btn, "click")

End Sub

Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)

  Dim theEvent As Object

  htmlElementWithEvent.Focus
  Set theEvent = htmlDocument.createEvent("HTMLEvents")
  theEvent.initEvent eventType, True, False
  htmlElementWithEvent.dispatchEvent theEvent
End Sub

您可以尝试修改样本并尝试进行最终测试，并让我们知道您的测试结果。是否有效。