Click here to Skip to main content
15,881,666 members
Please Sign up or sign in to vote.
1.00/5 (1 vote)
See more:
Hi All. I am trying to scrapping data from website to the excel file.
The route idea here.

For the row from startrow to stoprow.

Navigate ie to the website that the link can get from a cell in excell.
Collect information and save back to excel.
Next

The problem that I only can run about 30 rows each time and then IE crash or IE busy and I have to stop and rerun manually.

Please help.

What I have tried:

Sub UpdateProjectListV2(startRow As Long, StopRow As Long)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Dim BaseWorkbook As Workbook
    Set BaseWorkbook = ThisWorkbook
    Dim FuncUpdateBid, FuncPStatus, FuncProCountry, FuncProBudget, sDate1 As String
    Dim DeleteP As Object
    Dim NumbidElem As IHTMLElement
    Dim i, iTotalRows As Long
    Dim stemp As String
    iTotalRows = BaseWorkbook.Worksheets("Project Info").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
    sDate1 = Format(Now(), "mmm dd,yyyy")
    Dim appIE As InternetExplorer
    Set appIE = CreateObject("internetexplorer.application")
            For i = startRow To StopRow
                With appIE
                    .navigate BaseWorkbook.Worksheets("Project Info").Cells(i, 11).Value
                    .Visible = True
                    '.Visible = False
                End With
                Do Until (appIE.READYSTATE = 4 And Not appIE.Busy)
                    DoEvents ' DoEvents releases the macro and lets excel do other thing while it waits
                Loop
                If BaseWorkbook.Worksheets("Project Info").Cells(i, 4).Value = 1 Then   'No need to update the complete project
                    If (InStr(BaseWorkbook.Worksheets("Project Info").Cells(i, 11).Value, "https://www.freelancer.com/contest/") <> 0) Then
                        BaseWorkbook.Worksheets("Project Info").Cells(i, 4).Value = "Contest"
                    Else
                        If appIE.document.getElementsByClassName("alert-block").Length <> 0 Then    'Project have been delete
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 3).Value = sDate1
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 4).Value = 0
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 6).Value = "Project Deleted"
                        Else
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 3).Value = sDate1
                                    BaseWorkbook.Worksheets("Project Info").Cells(i, 6).Value = appIE.document.getElementById("project_status").innerText
                                    If BaseWorkbook.Worksheets("Project Info").Cells(i, 9).Value = "" Then 'Get Çountry
                                        BaseWorkbook.Worksheets("Project Info").Cells(i, 9).Value = appIE.document.getElementsByClassName("user-flag user-icons")(0).getElementsByTagName("img")(0).getAttribute("title")
                                    End If
                                    If BaseWorkbook.Worksheets("Project Info").Cells(i, 10).Value = "" Then   'Get Project budget
                                        BaseWorkbook.Worksheets("Project Info").Cells(i, 10).Value = appIE.document.getElementsByClassName("project-budget")(0).innerText
                                    End If
                                    If BaseWorkbook.Worksheets("Project Info").Cells(i, 1).Value = "" Then  'Get Project ID
                                        BaseWorkbook.Worksheets("Project Info").Cells(i, 1).Value = appIE.document.getElementsByClassName("ProjectReport")(0).getElementsByClassName("normal")(0).innerText
                                    End If
                                        If IsObject(appIE.document.getElementById("num-bids")) Then  'Some private project don't have bid
                                            BaseWorkbook.Worksheets("Project Info").Cells(i, 8).Value = appIE.document.getElementById("num-bids").innerText
                                        Else
                                            BaseWorkbook.Worksheets("Project Info").Cells(i, 8).Value = 0
                                        End If
                        End If
                    End If
                End If
                BaseWorkbook.Worksheets("Dashboard").Cells(8, 6).Value = i
            Next i
    appIE.Quit
    Set appIE = Nothing
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox ("Complete")
End Sub
Posted
Updated 24-May-19 19:46pm
v2
Comments
CHill60 23-Apr-18 9:15am    
Do you get an error message when it "crashes"?
hmanhha 23-Apr-18 9:45am    
Normally, Internet Explorer does not refresh and can not load the link.I have to close Internet Explorer then end the code and rerun it.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900