Excel VBA automatic fill and submit web forms from excel data

Nemat2313

New Member
Joined
Jan 18, 2016
Messages
18
Hi,

My below code works find with F8 key, but run key doesn't fill the web form. I tried so many time readyState function but still doesn't work. Could anyone knows whats the problem there.

Please watch this video to better understand the problem.
https://youtu.be/zxL5GlhG0iA


Code:
Sub Sprint()
   Dim IE As Object
   Dim objelement As Object
   Dim c As Integer
   Dim LastRow, i, j As Integer
  
   Set IE = CreateObject("InternetExplorer.Application")
   
   With IE
      .Visible = True
      .navigate "https://website url here #"
      
      'wait until first page loads
      Do Until .readyState = 4
        DoEvents
      Loop
   
      On Error Resume Next

Set sht = ThisWorkbook.Worksheets("Data")
LastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
For j = 4 To LastRow
       
    i = 112
             
         If IE.document.all.Item(i).innertext = "ÔÍÑ (ãîñ. ïîøëèíà)" Then
         IE.document.all.Item(i).Click
         
         End If
    
   IE.Visible = True
   While IE.Busy
   DoEvents  'wait until IE is done loading page.
   Wend
         
   'populate fields
   
   With IE.document
      'text boxes
      
      .all("fio").Value = sht.Cells(j, 1) 
      .all("contact").Value = sht.Cells(j, 2)
      .all("payer_address").Value = sht.Cells(j, 3) 
      .all("inn_from").Value = sht.Cells(j, 4) '"771562265931"
      .all("inn").Value = sht.Cells(j, 5) '"7726062105"
      .all("account").Value = sht.Cells(j, 6) '"45914000"
      .all("purpose").Value = sht.Cells(j, 7) 
      .all("comment").Value = sht.Cells(j, 8) '"02.04.2016"
      .all("sum").Value = sht.Cells(j, 10) '"1000"
      .all("get_total_sum").Click
      '.all("now_pay").Click
    
    End With
        Set IE = Nothing

    Next j
 End With
End Sub
 
Nemat, HTML code shared by you is not complete. Install Firebug addon and right click on Pop Up dialog box and click inspect element with firebug. Share only dialogue box html code here. After that I can only able to figure out some solution !
 
Upvote 0

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Nemat, I asked HTML code of dialogue box where Ok and Cancel button are appearing not the page on which you're filling all details. Right click on Pop Up dialog box when it appear and share that code here. Further, Along with Popup Box HTML Code, If you can share link of any public site on which similar popup is coming then it would be of great help !
 
Upvote 0
Ombir, I think there isn't HTML code for Pop Up dialog box. Wacth below video to see what appears when I click Submit button and Ok button.

https://drive.google.com/open?id=0B8mEUFOrXM4tQ2VLMlo3T3J0OWdRMFgxZGZkS3hZYTNhdDdJ

There is highlights below code once when I click OK button this code
<div class="igtranslator-activator-icon bounceIn" style="background-image: url("resource://jid1-dgnibwqga0sibw-at-jetpack/data/icons/home.png"); display: none; top: 409px; left: 1165px;" title="Click to Show Translation"></div>
 
Upvote 0
div class="igtranslator-activator-icon bounceIn" style="background-image: url("resource://jid1-dgnibwqga0sibw-at-jetpack/data/icons/home.png"); display: none; top: 436px; left: 1190px;" title="Click to Show Translation"></div
 
Upvote 0
Ombir, I've resolved the problem by using AutoIt program. AutoIt can press enter on the active windows. The disadvantages is it is not running background, because of AutoIt should press enter of active window. Any way it is awesome to easy job. Thank you very much for your help!

Here is the code for AutoIt program:
Code:
WinWait("Run", "", 1)
Send("{Enter}")

Code:
Dim IE As Object
Sub Sprint3()
   Dim objelement As Object
   Dim c As Integer
   Dim LastRow, i, j, m As Integer
   Dim UrlTochka As String

   Set IE = CreateObject("InternetExplorer.Application")
    
    Set sht = ThisWorkbook.Worksheets("Data")
    LastRow = sht.Cells(sht.Rows.Count, "D").End(xlUp).Row
    UrlTochka = "https://website.com#"

    For j = 4 To LastRow
        Select Case j
            Case 20
               ActiveWindow.SmallScroll Down:=18
            Case 40
               ActiveWindow.SmallScroll Down:=18
            Case 80
               ActiveWindow.SmallScroll Down:=18
            Case 120
               ActiveWindow.SmallScroll Down:=18
            Case 160
               ActiveWindow.SmallScroll Down:=18
            Case 200
               ActiveWindow.SmallScroll Down:=18
            Case 240
               ActiveWindow.SmallScroll Down:=18
            Case 280
               ActiveWindow.SmallScroll Down:=18
            Case 320
               ActiveWindow.SmallScroll Down:=18
            Case 360
               ActiveWindow.SmallScroll Down:=18
             End Select
    sht.Range(Cells(j, 1), Cells(j, 15)).Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 6750105
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With IE
                
      .Visible = True
      .navigate UrlTochka
      
      'wait until first page loads
   IEready
      On Error Resume Next
      
    i = 112
             
         If IE.document.all.Item(i).innertext = "text here on the site" Then
         IE.document.all.Item(i).Click
         
         End If
    
   IE.Visible = True
   
   IEready

   'populate fields
   
      If sht.Cells(j, 3) <> "" Then
      IE.document.all("inn_from").Value = sht.Cells(j, 3)
      End If
      
   With IE.document
      'text boxes
      .all("fio").Value = sht.Cells(j, 4)
      .all("contact").Value = "9117057773"
      .all("payer_address").Value = sht.Cells(j, 6) & " " & sht.Cells(j, 5)
      .all("inn").Value = sht.Cells(j, 9) '"7726062105"
      .all("account").Value = sht.Cells(j, 8) '"45914000"
      .all("purpose").Value = 'sht.Cells(j, 7)
      .all("comment").Value = Format(sht.Cells(j, 10).Value, "dd/mm/yyyy") '"02.04.2016"
      .all("sum").Value = sht.Cells(j, 11) '"1000"
      .all("get_total_sum").Click
      
    End With
      
     PressEnter
     IE.document.all("now_pay").Click
     IEready_Two
      
    sht.Range(Cells(j, 1), Cells(j, 15)).Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    sht.Cells(j, 14) = "Paid"
    End With
 Next j
  Set IE = Nothing
  m = LastRow - 3
  MsgBox m & " person has been paid!"
End Sub
Private Sub Wait(ByVal wSec As Long)
    wSec = wSec + Timer
    Do While Timer < wSec
       DoEvents
    Loop
End Sub
Private Sub IEready()
    Wait 1
    Do While IE.readyState <> 4
        Wait 1
    Loop
End Sub

Private Sub IEready_Two()
    Wait 5
    Do While IE.readyState <> 4
        Wait 5
    Loop
End Sub

Private Sub PressEnter()
Dim runscript
Dim FileName As String

FileName = ThisWorkbook.Path & "\PressEnter.au3"
runscript = Shell("C:\Program Files (x86)\AutoIt3\AutoIt3_x64.exe " & FileName)

End Sub
 
Upvote 0
I have been able to use Ombir's original adaptation to kind of meet my needs, but my problem is that the macro never ends. It just keeps running, even though nothing is changing.

I am using the code to loop through a range in my worksheet and put an SSN and DOB value on a webpage to check an eligibility, but it never gets past the first range (A2 and B2). I want the code to then go to A3, B3, and so on.
Code:
Sub Sprint()   Dim objelement As Object
   Dim c As Integer
   Dim LastRow, i, j As Integer
   
  
  
   Set IE = CreateObject("InternetExplorer.Application")
   
   With IE
      .Visible = True
      .navigate "https://www.njmmis.com/mevs.aspx"
      
      'wait until first page loads
   Ieready
      On Error Resume Next


Set sht = ThisWorkbook.Worksheets("Data")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).row
For j = 2 To LastRow
       
    i = 112
             
         If IE.document.all.Item(i).innertext = "ÔÍÑ (ãîñ. ïîøëèíà)" Then
         IE.document.all.Item(i).Click
         
         End If
    
   IE.Visible = True
   
   Ieready
         
   'populate fields
  
  
   With IE.document
    
      'text boxes
      .all("rblParams")(2).Checked = True
      .all("txtBeginDate").Value = "06/01/2016"
      .all("txtEndDate").Value = "06/30/2016"
      .all("txtSSN").Value = sht.Cells(j, 1)
      .all("txtDOB").Value = Format(sht.Cells(j, 2), "mm/dd/yyyy")
      .all("btnSubmit").Click
      
    
      
   
    
    End With
    
        Set IE = Nothing


    Next j
 End With
End Sub
    Private Sub Wait(ByVal wSec As Long)


    
       wSec = wSec + Timer
        Do While Timer < wSec
           DoEvents
        Loop
    End Sub


Private Sub Ieready()
    Wait 5
    Do While IE.readyState <> 4
        Wait 2
    Loop
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,987
Messages
6,122,614
Members
449,090
Latest member
vivek chauhan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top