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