VBA/Excel/Access/Word/Access/QueryTable

Building a New Web Query with VBA

   <source lang="vb">

Sub CreateNewQuery()

   Dim WSD As Worksheet
   Dim WSW As Worksheet
   Dim myQueryTable As QueryTable
   Dim FinalRow As Long
   Dim i As Integer
   Dim ConnectString As String
   Dim FinalResultRow As Long
   Dim RowCount As Long
   Set WSD = Worksheets("Portfolio")
   Set WSW = Worksheets("Workspace")
   FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
   For i = 2 To FinalRow
       Select Case i
           Case 2
               ConnectString = "URL;http://finance.Yahoo.ru/q/cq?d=v1&s=" & WSD.Cells(i, 1).Value
           Case Else
               ConnectString = ConnectString & "%2c+" & WSD.Cells(i, 1).Value
       End Select
   Next i
   For Each myQueryTable In WSW.QueryTables
       myQueryTable.Delete
   Next myQueryTable
   Set myQueryTable = WSW.QueryTables.Add(Connection:=ConnectString, _
       Destination:=WSW.Range("A1"))
   With myQueryTable
       .Name = "portfolio"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = True
       .RefreshOnFileOpen = False
       .BackgroundQuery = False
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .WebSelectionType = xlSpecifiedTables
       .WebFormatting = xlWebFormattingNone
       .WebTables = "11"
       .WebPreFormattedTextToColumns = True
       .WebConsecutiveDelimitersAsOne = True
       .WebSingleBlockTextImport = False
       .WebDisableDateRecognition = False
       .WebDisableRedirections = False
   End With
   myQueryTable.Refresh BackgroundQuery:=False
   FinalResultRow = WSW.Cells(Rows,Count, 1).End(xlUp).Row
   WSW.Cells(1, 1).Resize(FinalResultRow, 7).Name = "WebInfo"
   RowCount = FinalRow - 1
   WSD.Cells(2, 2).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,3,False)"
   WSD.Cells(2, 3).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,4,False)"
   WSD.Cells(2, 4).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,5,False)"
   WSD.Cells(2, 5).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,6,False)"
   WSD.Cells(2, 6).Resize(RowCount, 1).FormulaR1C1 = "=VLOOKUP(RC1,WebInfo,2,False)"

End Sub

</source>
   
  

creates a QueryTable object on the active worksheet and sets its data source to a single table from a Web page at the designated location:

   <source lang="vb">

Public Sub ImportWeb()

  Dim qt As QueryTable
  Set qt = ActiveSheet.QueryTables.Add(Connection:=" URL;http://finance.yahoo.ru/q?s=^DJI&d=v1", _
       Destination:=Range("A1"))
   With qt
       .name = "DJIQuery"
       .WebSelectionType = xlSpecifiedTables
       .WebTables = "16"    " DJI table
       .WebFormatting = xlWebFormattingNone
       .EnableRefresh = True
       .RefreshPeriod = 5   "Unit in minutes
       .Refresh     "Execute query
   End With
   Set qt = Nothing

End Sub

</source>
   
  

Using VBA to Update an Existing Web Query

   <source lang="vb">

Sub RefreshAllWebQueries()

   Dim QT As QueryTable
   For Each QT In ActiveSheet.QueryTables
       Application.StatusBar = "Refreshing " & QT.Connection
       QT.Refresh
   Next QT
   Application.StatusBar = False

End Sub

</source>