Hi all, I would like to create a web Data query from the web in Excel that refreshes every 10 seconds.
It is for football scores. My current code is below, which runs the query each time - but Ijust wonder if there is a quicker way to do this which will just refresh the existing connection rather than creating a new one?
Sub Fixtures()
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Sheet1").Range("2:2000").ClearContents
Application.StatusBar = "Downloading Scores and Fixtures"
'location of my HTTP addresses
URLVal1 = Range("URL!A1")
URLVal2 = Range("URL!B1")
URLVal3 = Range("URL!C1")
Application.CutCopyMode = False
With Sheets("Sheet1").QueryTables.Add(Connection:= _
"URL;" & URLVal1, Destination:=Range("Sheet1!$A$2"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
DATA_SELECTION:
'.WebSelectionType = xlEntirePage
.WebSelectionType = xlSpecifiedTables
.WebTables = "3"
DATA_FORMATTING:
'.WebFormatting = xlWebFormattingAll
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
With Sheets("Sheet1").QueryTables.Add(Connection:= _
"URL;" & URLVal2, Destination:=Range("Sheet1!$A$82"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
DATA_SELECTION2:
'.WebSelectionType = xlEntirePage
.WebSelectionType = xlSpecifiedTables
.WebTables = "3"
DATA_FORMATTING2:
'.WebFormatting = xlWebFormattingAll
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
With Sheets("Sheet1").QueryTables.Add(Connection:= _
"URL;" & URLVal3, Destination:=Range("Sheet1!$A$162"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
DATA_SELECTION3:
'.WebSelectionType = xlEntirePage
.WebSelectionType = xlSpecifiedTables
.WebTables = "3"
DATA_FORMATTING3:
'.WebFormatting = xlWebFormattingAll
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
For Each qtb In ActiveSheet.QueryTables
qtb.Delete
Next
Application.StatusBar = ""
Application.OnTime Now + TimeValue("00:00:10"), "Fixtures"
Application.ScreenUpdating = True
End Sub
Bookmarks