PDA

View Full Version : Pulling Data from Web - page still loading



singh246
02-18-2016, 03:04 AM
Hi,

I have created a macro which pulls data from the web however I think sometimes the page hasn't fully loaded because the data that gets imported is not complete.

I have pasted the code below. It's only the top part that may need changing, but I don't know how I can tell it to wait till the page has fully loaded.

Would really appreciate any help. Thanks


Sub GetDataLooped()


For i = 1 To 10

Application.ScreenUpdating = False
urlcurrent = Worksheets("URLs").Range("B1").Offset(i - 1, 0).Value
inputurl = "URL;" & urlcurrent
Sheet1.Activate

With ActiveSheet.QueryTables.Add(Connection:= _
inputurl _
, Destination:=Sheet1.Range("$A$1"))
.Name = _
"find.html?locationIdentifier=REGION^274&maxDaysSinceAdded=1&sortType=6&numberOfPropertiesPerPage=10"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False

End With


rawoutput = Range("A21").Value

If InStr(1, rawoutput, "1-1 ") = 1 Then
Number = 1
Else

If InStr(1, rawoutput, "new") > 0 Then

If InStr(1, rawoutput, "1-10") = 1 Then

finish = InStr(rawoutput, "new")
Number = Mid(rawoutput, 9, finish - 9)

Else

finish = InStr(rawoutput, "new")
Number = Mid(rawoutput, 8, finish - 9)

End If

Else

If InStr(1, rawoutput, "1-10") = 1 Then

finish = InStr(rawoutput, "properties")
Number = Mid(rawoutput, 9, finish - 10)

Else

finish = InStr(rawoutput, "properties")
Number = Mid(rawoutput, 9, finish - 10)

End If

End If
End If

Sheet1.Cells.QueryTable.Delete
Sheet1.Cells.ClearContents

Worksheets("Data").Activate
Application.ScreenUpdating = True
Worksheets("Data").Range("B:B").Find(Date, LookIn:=xlValues).Offset(, i).Value = Number

Next i

Worksheets("Data").Range("B:B").Find(Date).Offset(, -1).Value = Time
End Sub