Scraping data from web to Excel: Code Works When "Stepping Into" (Using F8), But Not When Running as Normal

[randaubienghoc]

Hi everyone,

I really need your kind support to revise the code.
My job is to get data from a website by filling some search criteria, clicking on search button and pulling necessary information to Excel file.
However, the code is driving me crazy when nothing comes to Excel when I run the code normally but it runs once F8 is activated to run through steps.

Could anybody help me with this issue?
My attached file FYI.

Thanks so much.

Sub PullDataFromWeb()
  Dim IE As Object, W As Excel.Worksheet
  Dim doc As HTMLDocument
  Dim lastRow As Integer, b As Boolean, tmp As String, a2 As String
  Dim lis, li
  Dim SearchButton As Object
    
    
  Set W = ThisWorkbook.Sheets("Sheet1")
  Set IE = VBA.CreateObject("InternetExplorer.Application")
  IE.Visible = True   'hien cua so IE
  IE.navigate "http://pus.customs.gov.vn/faces/ContainerBarcode"
  Do While IE.Busy Or IE.readyState <> 4      'doi IE chay xong
    Application.Wait DateAdd("s", 1, Now)
  Loop
  Set doc = IE.document

  lastRow = W.Range("B" & W.UsedRange.Rows.Count + 2).End(xlUp).Row        'dong cuoi cung trong cot B container
  If lastRow < 2 Then GoTo Ends
  On Error Resume Next
  For intRow = 2 To lastRow     'tu dong toi dong
    b = False
    b = W.Range("I" & intRow).Value Like "[Yy]"
    
    If W.Range("B" & intRow).Value <> "" And Not b Then
      doc.getElementById("pt1:it2::content").Value = W.Range("B" & intRow).Value 'so TK
      doc.getElementById("pt1:it1::content").Value = W.Range("A" & intRow).Value 'ma DN
      doc.getElementById("pt1:it3::content").Value = W.Range("C" & intRow).Value 'ma HQuan
      doc.getElementById("pt1:it4::content").Value = W.Range("D" & intRow).Value 'ngay TK
      
   Set SearchButton = doc.getElementsByClassName("btngetdata xfl p_AFTextOnly")(0)
   SearchButton.Click
  
     Do While IE.Busy Or IE.readyState <> 4
        Application.Wait DateAdd("s", 1, Now)
      Loop
      

                  
    strFindTrangThaiTK = ""
    strFindTrangThaiTK = doc.getElementById("pt1:png1").getElementsByTagName("table")(1).Rows(4).Cells(0).innerText
    a2 = ""
    a2 = doc.getElementsByClassName("x15p")(0).innerText
    
    If LCase(a2) Like "*khai*" And strFindTrangThaiTK = "" Then      'error window pop-up
    strFindTrangThaiTK = a2
    W.Range("E" & intRow) = strFindTrangThaiTK
    doc.getElementById("d1_msgDlg::close").Click
    Else
        
        W.Range("E" & intRow) = strFindTrangThaiTK
      
    End If
    End If
    

    
  Next
Ends:

  IE.Quit
  Set IE = Nothing    'Cleaning up
  Set objElement = Nothing
  Set objCollection = Nothing
  Application.StatusBar = ""
  Application.DisplayAlerts = True
 
Application.ScreenUpdating = True
MsgBox "PUS CUSTOMS UPDATED!"

End Sub

 

[randaubienghoc]

Anybody? Please help (((((((((((

 

[RoryA]

Please don't bump your thread that quickly. Everyone here is a volunteer and in different timezones, so you need to be patient. Also, bumping your thread removes it from the 'Zero replies' list which some people go through when they first log on, so you can actually be reducing your chances of getting a reply.

 

[wornhall]

Anybody? Please help (((((((((((

This is an application that is perfectly suited to Power Query. I strongly suggest you migrate to that solution. You will like it.