VBA循环:自动填写Web表单

时间:2018-11-27 08:46:49

标签: excel vba excel-vba loops automation

我的目标是使用存储在excel表中的动态数据填充Web表单。 该过程应如下所示:

  1. A。
    1. 转到存储在“ A” i中的链接
    2. 使用从“ A” i到“ G” i的数据填写Web表单中的给定字段
    3. 点击“保存”
    4. 等待5秒
    5. 使用文本“ Created”填充“ H” i列
    6. 重复下一行(i + 1)直到最后一行
    7. 完成后(最后一行之后),msgbox:“处理完成”
  

下面是我的没有循环的版本,但仅适用于B2:G2行。

Sub copy_project_loop()

Dim IE As Object
Dim Doc As HTMLDocument
Set IE = CreateObject("InternetExplorer.Application")
Dim SHELL_OBJECT
SHELL_OBJECT = "WScript.Shell"
Set objShell = CreateObject(SHELL_OBJECT)


IE.Visible = True
IE.navigate "URL link"

    Do While IE.Busy
         Application.Wait DateAdd("s", 1, Now)
    Loop
    Set Doc = IE.document

Doc.getElementById("Project|Name").Value = ThisWorkbook.Sheets("data").Range("B2").Value
Doc.getElementById("customer|UserDefinedIdTA").Value = ThisWorkbook.Sheets("data").Range("C2").Value
    Doc.getElementById("customer|UserDefinedIdTA").Focus
        objShell.SendKeys "{Enter}"
            Application.Wait DateAdd("s", 2, Now)
Doc.getElementById("selEngagement").Value = ThisWorkbook.Sheets("data").Range("D2").Value
Doc.getElementById("txtPlannedStart").Value = ThisWorkbook.Sheets("data").Range("E2").Value
Doc.getElementById("Project|ProjTimeAppTA").Value = ThisWorkbook.Sheets("data").Range("F2").Value
Doc.getElementById("Project|SecondProjTimeAppTA").Value = ThisWorkbook.Sheets("data").Range("G2").Value
    Application.Wait DateAdd("s", 5, Now)
Doc.getElementById("Button1").Click

End Sub

请协助我为此任务定义一个循环。

感谢您的支持, 斯拉瓦。

1 个答案:

答案 0 :(得分:1)

对于可能发现它有用的任何人,下面是一个很好的示例,说明了如何循环遍历表中存储的动态数据范围并使用它填充Web表单。 非常感谢Kamolga帮助我完成了这项出色的任务。

Sub DynamicWebPage()

' here I define elemnts for the loop
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("data")
Dim LastRow As Long
Dim i As Long
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

' here I define Internet Explorer
Dim IE As Object
Dim Doc As HTMLDocument
Set IE = CreateObject("InternetExplorer.Application")

' here I define Object to sendkeys
Dim SHELL_OBJECT
SHELL_OBJECT = "WScript.Shell"
Set objShell = CreateObject(SHELL_OBJECT)

' here I define range for the loop
For i = 2 To LastRow

' here I ask the Internet explorer to be visable & Navigate to value in cell "H"i
IE.Visible = True
IE.navigate sht.Range("H" & i).Value

' here I ask the Internet explorer to wait few seconds
Do While IE.Busy
    Application.Wait DateAdd("s", 5, Now)
Loop

Set Doc = IE.document

'******* From here the macro fill the data from excel table in range into WEB elements******
Doc.getElementById("Project|Name").Value = sht.Range("A" & i).Value
Doc.getElementById("customer|UserDefinedIdTA").Value = sht.Range("B" & i).Value
Application.Wait DateAdd("s", 1, Now)
Doc.getElementById("customer|UserDefinedIdTA").Focus
objShell.SendKeys "{Enter}"
Application.Wait DateAdd("s", 5, Now)
Doc.getElementById("selEngagement").Value = sht.Range("C" & i).Value
'date format should be m/d/yyyy
Doc.getElementById("txtPlannedStart").Value = sht.Range("D" & i).Value
Doc.getElementById("Project|ProjTimeAppTA").Value = sht.Range("E" & i).Value
Doc.getElementById("Project|SecondProjTimeAppTA").Value = sht.Range("F" & i).Value
Application.Wait DateAdd("s", 5, Now)
Doc.getElementById("Button1").Click

' here I ask to populate column "G"i with "created" string to know that this raw was successfully done
sht.Range("G" & i).Value = "Created"

Next i
MsgBox "Process 100% completed"

End Sub
相关问题