HTML-Datei-Download aus dem Internet mit URLDownloadToFile erstellt leere Datei

Question

Ich habe ein Problem, das in diesem Forum in der Vergangenheit diskutiert wurde, aber obwohl Lösungen für die spezifischen Fälle vorgeschlagen worden waren, war keiner für mich nützlich. Ich möchte eine Datentabelle mit aktuellen Aktienkursen analysieren. Genau dies ist ein Yahoo-Portfolio. Die URL lautet "https://finance.yahoo.com/portfolio/pf_5/view/view_0". Wenn ich versuche, das Portfolio über eine Webverbindung in mein Arbeitsblatt zu importieren, ist im Importfenster kein Inhalt zu sehen. Dies funktioniert bis vor einiger Zeit gut, aber es scheint, dass Yahoo den Code geändert hat, so dass der Inhalt nicht mehr importiert werden kann. Daher kann ich die Website nicht mehr in einer Excel-Verbindung verwenden, um mein Portfolio zu importieren.

Aber ich kann die Datei mit Chrome ohne Eingabe von Anmeldeinformationen herunterladen (sie sind bereits in Chrome oder in einem Cookie gespeichert, weiß nicht) zu meinem Download-Ordner als HTML-Datei und wenn ich es in einem Browser öffnen wird nicht nur wie das Original angezeigt, sondern ich kann die heruntergeladene Datei auch mit Excel analysieren. Die Dateilänge der direkt vom Browser heruntergeladenen Datei beträgt 256 kB. So scheint es, dass der Server erkennt, wie die Datei verwendet wird, und ermöglicht es, sie zu speichern, aber nicht online zu analysieren.

Jetzt versuche ich eine vba Sub zu schreiben, die die Website öffnet, lädt die Datei herunter und analysiert dann die gespeicherte Version. Der Analyseteil funktioniert einwandfrei, aber ich kann keinen funktionierenden Download in den Code einfügen. Wenn ich die URLDownloadToFile (0, URL1, URL2, 0, 0) -Methode (URL1 ist die https-Adresse und URL2 ist der Dateiname und Pfad), die heruntergeladene Datei hat nur 75kB und enthält einige Java-Code, aber es gibt keine Daten, die auf dem Bildschirm zu sehen sind, wenn ich sie mit dem Browser betrachte, und wenn ich versuche, den Inhalt nach Excel zu importieren, wird nichts importiert. Während URLDownloadToFile in den meisten Fällen funktioniert, funktioniert es nicht mit den Yahoo-Portfolio-Webseiten. Meine Frage ist: 1) Könnte es helfen, die Parameter der Funktion zu ändern (Parameter 1 = pcaller?). Aber wie? 2) Gibt es noch eine andere bekannte Methode in vba, um eine Webseite zu speichern, ohne sie zeilenweise zu lesen (probiert dies auch und funktioniert auch nicht)? Dies sind zwei Methoden, die ich versuchte:

Option Explicit 
'Declarations 
Private Declare Function URLDownloadToFile Lib "urlmon" _ 
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ 
ByVal szURL As String, ByVal szFileName As String, _ 
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long 

'Download Code 
Sub download() 

Dim done 
Dim URL1 As String 
Dim URL2 As String 

URL1 = "https://finance.yahoo.com/portfolio/pf_5/view/v1" 
URL2 = "C:\Users\xxx\Downloads\pf1 - Yahoo Finance Portfolios.html" 

'This will provide a return value to test. 
'Note the ( ) around the args 
done = URLDownloadToFile(0, URL1, URL2, 0, 0) 

'Test. 
If done = 0 Then 
    MsgBox "File has been downloaded!" 
Else 
    MsgBox "File not found!" 
End If 

End Sub 

---

Sub SaveWebFile() 'this creates an "empty" file! 
Dim URL1 As String 
Dim URL2 As String 

URL1 = "https://finance.yahoo.com/portfolio/pf_5/view/v1" 
URL2 = "C:\Users\xxxx\Downloads\pf1 - Yahoo Finance Portfolios.html" 

Set fso = CreateObject("Scripting.fileSystemObject") 
    With CreateObject("MSXML2.XMLHTTP") 
    .Open "GET", URL1, False 
    .send 
    Text = .responseText 
    End With 
Set objOutputFile = fso.CreateTextFile(URL2, True) 
objOutputFile.Write Text 
objOutputFile.Close 

End Sub 

Answer 1

Während eine Antwort abzuwarten ich nach anderen Lösungen suchen weiter und fand eine, die in meinem Fall funktioniert. Dies ist nicht genau die Antwort, nach der ich gesucht habe, aber sie löst mein Problem. Anstatt die Yahoo-Portfolio-Seite zu verwenden, verwende ich jetzt die Yahoo Finance API (see [Alternative to google finance api (closed)). Die URL

http://finance.yahoo.com/d/quotes.csv?s=symbol1[+symbol2+symbol3...]&f=format_code

erstellt eine herunterladbare Komma getrennte Textdatei (CSV), die direkt in VBA gespeichert oder ausgewertet werden können. [symbol1 ...] sind die Ticker-Symbole der Aktien, die Sie analysieren möchten und {Format Code} wird eine Reihe von Briefen, die die Art der Daten beschreiben, die Sie sehen wollen (vollständige Liste in http://www.jarloo.com/yahoo_finance/)

Da ich nur das Aktiensymbol und den letzten Preis ohne Zeit brauche, ist mein Formatcode "sl1". Es gibt jedoch einen Haken oder eigentlich zwei. Die erste (von Yahoo auferlegte) ist, dass die maximale Anzahl der erlaubten Symbole 200 ist und dass Ihre IP blockiert werden könnte, wenn Sie in kurzer Zeit zu viele Anrufe tätigen. So können Echtzeit-Streaming-Daten wahrscheinlich nicht auf diese Weise erhalten werden, obwohl die Formatliste Code für Echtzeitdaten enthält.

Die zweite ist durch die QueryTables.Add Methode, die ich in den folgenden Code verwenden, der die URL auf 255 Zeichen beschränkt. Wenn die URL-Zeichenfolge länger ist, tritt ein Laufzeitfehler auf. Dies bedeutet, dass die zweite Begrenzung vor Erreichen der 200 Symbole auftritt.

Der folgende Code behebt dieses Problem mit einer Schleifenstruktur, indem so viele Aufrufe wie erforderlich erstellt werden, um die Daten für alle Symbole abzurufen, wobei für jeden Aufruf eine URL mit weniger als 256 Zeichen verwendet wird. In meinem Test verwende ich eine Arbeitsmappe test.xlsm mit zwei Arbeitsblättern test und pf1. PF1 enthält eine Liste aller abzurufenden Symbole in Spalte A ab Zeile 3. Die erste Zeile im Blatt "test" hat die Anfangszeile dieser Daten in D1 (= 3) und die Zeile des letzten Symbols in E1.

Mein Sub hat eine äußere Schleife, die die innere Schleife so oft wiederholt wie nötig, um alle Symbole zu holen.

Die innere Schleife erstellt die URL1 für den Aufruf und fügt so viele Symbole wie möglich zum Basisteil der URL hinzu, mit der Bedingung, dass sie unter 256 Zeichen bleiben muss.Nachdem die URL vollständig ist, wird der tatsächliche Zeiger auf die Symbolliste wird als "First" gespeichert und die Daten werden abgerufen. Dann wird eine neue URL für den nächsten Datenstapel aus der Liste berechnet.

Nachdem alle Daten abgerufen wurden, werden Zeilenhöhe und Spaltenlänge im Ergebnisblatt zurückgesetzt, weil ich bemerkt habe, dass sie während der Operation geändert werden (weiß nicht warum).

Ich habe auch festgestellt, dass einige der Preiswerte, die im US-Dezimalformat (mit Dezimalpunkt "Punkt") kommen, den Punkt während der Abfrage verlieren können. Nicht sicher, ob dies an meinem Zahlenformat (europäisch, mit "Komma") oder an einem Problem mit der Abfrage selbst liegt. Im Idealfall sollte mein Zahlenformat keinen Einfluss haben, da die heruntergeladenen Daten alle TEXT sein sollten. Auf jeden Fall ist es notwendig, eventuelle Ausreißer zu korrigieren, indem eine Liste von ungefähren Preiswerten für alle Symbole verwendet wird. Diese Korrektur ist in diesem Unterabschnitt nicht enthalten.

Sub Import_CSV_File_From_URL() 

Dim URL1 As String 
Dim URL As String 
Dim ws As Worksheet 
Dim First As Long 
Dim Last As Long 
Dim i As Long 
Dim URLlen As Long 
Dim NxtLen As Long 
Dim destCell As Range 
Dim qt As QueryTable 


Set ws = ActiveSheet 

URL = "http://finance.yahoo.com/d/quotes.csv?s=" 
First = ws.Range("D1") 
Last = ws.Range("E1") 
i = First 

Do While i < Last       'loop through all symbols 

    ws.Range("A" & First & ":Z1000").Clear 'clear all cells otherwise query inserts new columns. 
    Set destCell = Worksheets("test").Range("A" & First) 

    URL1 = URL 
    For i = First To Last 
     If i > First Then 
      URL1 = URL1 & "+" 
     End If 
     URL1 = URL1 & Worksheets("pf1").Range("A" & i)      'add up to 200 symbols but 
     If Len(URL1) > 249 - Len(Worksheets("pf1").Range("A" & i + 1)) Then 'len(URL1) cannot be >255!! 
      First = i + 1  'save index for next batch of symbols 
      Exit For 
     End If 
    Next i 

    URL1 = URL1 & "&f=sl1"   'format "sl1": get symbol & last Trade for these tickers 

    With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & URL1, Destination:=destCell) 
     .TextFileStartRow = 1 
     .TextFileParseType = xlDelimited 
     .TextFileCommaDelimiter = True 
     .PreserveFormatting = True 
     .Refresh BackgroundQuery:=False 
    End With 
    For Each qt In ActiveSheet.QueryTables 
     If qt.Refreshing Then qt.CancelRefresh 
     qt.Delete          'delete internal query tables 
    Next  

Loop  'add next batch of symbols 

ws.Range("A:B").ColumnWidth = 8 
For i = 3 To Last 
    ws.Rows(i).RowHeight = 15 
Next i 
End Sub