1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Help please: VBA macro to import data from web site

Discussion in 'Business Applications' started by andy63, Apr 28, 2015.

Thread Status:
Not open for further replies.
  1. andy63

    andy63 Thread Starter

    Apr 28, 2015
    Hi Guys
    I have a macro that fetches data from the ASX web site.
    But I wan't to expand the fields. The problem is that the format of the new fields changes, so not sure how to tweak the code.

    Here's the macro.....

    Sub QueryTable_ASX()

    Dim wsASX As Worksheet, wsQT As Worksheet
    Dim qtASX As QueryTable
    Dim Cell As Range, Header As Range, FoundHeader As Range

    'On Error Resume Next

    Set wsASX = Sheets("ASXListedCompanies")
    Set wsQT = Sheets.Add(After:=Sheets(Sheets.Count))

    Set qtASX = wsQT.QueryTables.Add(Connection:= _
    "URL;http://www.asx.com.au/asx/research/companyInfo.do?by=asxCode&allinfo=&asxCode=ONT", _

    With qtASX
    .Name = "ASX"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = False
    .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


    'For Each Cell In wsASX.Range("B4:B12") 'For testing
    For Each Cell In wsASX.Range("B4", wsASX.Range("B" & Rows.Count).End(xlUp))
    qtASX.Connection = "URL;http://www.asx.com.au/asx/research/companyInfo.do?by=asxCode&allinfo=&asxCode=" & Cell.Value
    For Each Header In wsASX.Range("D3:I3")
    Set FoundHeader = wsQT.Range("A:A").Find(Header, , , xlWhole, , , False)
    If Not FoundHeader Is Nothing Then
    wsASX.Cells(Cell.Row, Header.Column).Value = FoundHeader.Offset(, 1).Value
    End If
    Next Header
    Next Cell

    End Sub

    If you have a look at one of the pages, eg for BHP.... http://www.asx.com.au/asx/research/company.do#!/BHP/details
    the above macro is currently fetching six fields, according to headers in the range D3:I3.
    I also want it to fetch the name of the CEO or Managing Director under "Directors/Senior Management", so would need to add another two fields and increase range to D3:K3, but not sure how to actually fetch the name and also the title (sometimes it's CEO, sometimes it's Managing Director).
    I have attached the file, and have included the two new fields - "Title" and "CEO Name".

    Any help would be greatly appreciated!!!


    Attached Files:

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1147385

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice