Website aftappen

Status
Niet open voor verdere reacties.
snb

snb

Verenigingslid
Lid geworden
12 jun 2008
Berichten
19.710
Geachte forumleden.

In plaats van in carnavalstijd bier, probeer ik een website af te tappen.

De volgende: https://download.bls.gov/pub/time.series/cx/cx.data.1.AllData

Ik heb de volgende 3 methodes geprobeerd.
Helaas zonder resultaat.

Heeft iemand een nuchtere suggestie die wel tot resultaat leidt in Excel 2010 ?
Het aantal 'regels' bedraagt ca. 420000.
Opgeslagen in een csv-bestand is het ca. 26 Mb.

Code: 
Sub M_snb()
   With CreateObject("MSXML2.XMLHTTP")
      .Open "GET", "https://download.bls.gov/pub/time.series/cx/cx.data.1.AllData", False
      .send
      c00 = .responseText
   End With

   With Sheet1.QueryTables.Add("URL;https://download.bls.gov/pub/time.series/cx/cx.data.1.AllData", Sheet1.Cells(1))
    .BackgroundQuery = True
    .Refresh False
   End With
   
   With Sheet1.QueryTables.Add("TEXT;https://download.bls.gov/pub/time.series/cx/cx.data.1.AllData", Sheet1.Cells(1))
    .BackgroundQuery = True
    .Refresh False
   End With
End Sub

NB. In het Excel subforum ga ik een koppeling naar deze vraag plaatsen.
Daar zitten nl. ook behoorlijk wat wizz'kids'
 
snb,

Ik heb de tweede optie geprobeerd en vult keurig blad1 ( na aanpassing van sheet1 naar Blad1, aangezien ik de Nederlandse versie gebruik). Vreemde bijkomstigheid is dat er 10 extra lege tabbladen worden aangemaakt. Het zijn trouwens 417218 rijen ! :)

Ik heb echter excel 2016, dus wellicht dat het daardoor wel bij mij werkt en niet bij jou.

Eerste optie doet niks en de derde optie werkt perfect.


Edit:
Ik heb de derde optie op Excel 2010 gedraaid en ook daarop werkt het perfect.
 
Laatst bewerkt:
Ha SjonR,

Dat klinkt bemoedigend !

Dankjewel voor de tests.
Moet nu mijn hoofd gaan breken over de vraag waarom het bij mij niet loopt.
Meedenken wordt gewaardeerd.
 
Heb jij nog steeds windows XP?
 
Misschien wel handig voor je speurtocht:

Excel 2016 draait bij mij op windows 8.1 en Excel 2010 draait op Windows 7.

en een detail buiten topic om: De link naar de tips die in je handtekening staat werkt niet (meer).
 
Laatst bewerkt:
Omdat jouw eerste suggestie ook niet bij jou werkt twijfel ik.

Bij mij werken ze alledrie (Excel 2016)

Wellicht (voor excel 2010) Listobject refreshen en niet de Querytable ( Sheet1.ListObjects(1).Refresh)

Daarnaast neem ik aan dat je niet steeds een connectie wilt maken? (maar wss enkel voor de test)

Heb onderstaand nog even een macro opgenomen in Excel 2016 wat hetzelfde resultaat geeft maar meteen in Tabelvorm (weet niet of dit in 2010 werkt, maar misschien heb je er wat aan)

Code: 
Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveWorkbook.Queries.Add Name:="cx data 1", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(Web.Contents(""https://download.bls.gov/pub/time.series/cx/cx.data.1.AllData""),[Delimiter=""   "", Columns=5, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""series_id"", type text}, {""year""," & _
        " Int64.Type}, {""period"", type text}, {""value"", Int64.Type}, {""footnote_codes"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""cx data 1"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [cx data 1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "cx_data_1"
        .Refresh BackgroundQuery:=False
    End With
End Sub
 
@Alpha

Ja dat klopt Excel 2010 in XP.

Wanneer ik via Python de gegevens binnenhaal draait het vlekkelings.
Als ik het Excelbestand dan aan de door Python in csv opgeslagen gegevens koppel is er niets aan de hand.

Alleen rechtstreeks in Excel binnenhalen vertoont kuren.
 
Hi snb,
Ik heb hem ook getest via mijn Excel 2010 onder Windows 10
Wel zijn bij mij de Add-Ins PowerPivot en PowerQuery ingeschakeld.
Test1 werkt niet.
Test2 werkt snel.
Test3 werkt langzamer.
Nadat de macro's 1 keer hebben gelopen, hoef je daarna alleen maar Data \ RefreshAll te klikken om de queries te verversen.
 

Bijlagen

  • MS_Query(pcb).xlsb
    49,3 KB · Weergaven: 35
EvR

In Excel 2010 zijn listobjects voorbehouden aan Acces & Excel queries. Web en tekst moeten het doen met een kale vormgeving.

Piet ook bedankt voor het testen.

Voorlopig houd ik het er maar op dat Python beter in staat is gebruik te maken van het OS van MS dan MS zelf.

Ik zet de draad op opgelost.

Nog een prettige laatste carnavalsdag. :D
 
Prettige carnavalsdag!

Ik dacht dat er in XL2010 iets was met QueryTables in een Listobject (welke er niet uit ziet als een Listobject) en dat daarom het refreshen niet goed ging

Code: 
Sub tst()

    With Sheet1.QueryTables.Add("URL;https://download.bls.gov/pub/time.series/cx/cx.data.1.AllData", Sheet1.Cells(1))
        .BackgroundQuery = True
        .Refresh False
   End With

MsgBox "Listobjects:  " & Sheet1.ListObjects.Count & " QueryTables :" & Sheet1.QueryTables.Count
'Bij mij in 2013 en 2016 0 en 1, ik dacht dat dit in xl2010 andersom was.....

End Sub
 
Code: 
[SIZE=1]    With ActiveSheet.QueryTables.Add("URL;https://download.bls.gov/pub/time.series/cx/cx.data.1.AllData", Blad1.Cells(1))
        .WebSingleBlockTextImport = True
        .Refresh False
    End With[/SIZE]
 
@Alpha,

Jij kijkt wel aardig veel verder dan je neus lang is.

Jouw suggestie getest: de bekende piep.

Maar ik ga op jouw spoor verder zoeken.

Bedankt !
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan