Question

我有一个问题，过去在这个论坛中已经讨论过，但是虽然已经提出了具体案例的解决方案，但没有一个对我有用。我想分析一个包含近期股票报价的数据表。准确地说，这是雅虎的产品组合。网址为“https://finance.yahoo.com/portfolio/pf_5/view/view_0”。如果我尝试通过Web连接将项目组合导入我的工作表，则导入窗口中不会显示任何内容。直到前段时间这项工作还不错，但雅虎似乎已经更改了代码，因此内容无法再导入。因此，我无法再使用Excel连接中的网站导入我的投资组合。

但我可以使用Chrome下载该文件，而无需输入凭据（它们已经存储在Chrome或Cookie中，不知道）作为html文件存储到我的下载文件夹中，当我在浏览器中打开它时不仅显示原始，但我也可以用Excel分析下载的文件。直接从浏览器下载的文件的文件长度为256 kB。因此，似乎服务器识别文件的使用方式并允许存储它，但不能在线分析。

现在我正在尝试编写一个打开网站的vba sub，下载文件然后分析存储的版本。分析部分工作正常，但我无法在代码中包含工作下载。当我使用URLDownloadToFile（0，URL1，URL2,0,0）方法（URL1是https地址，URL2是文件名和路径）时，下载的文件只有75kB并包含一些java代码，但是没有数据当我使用浏览器观看时在屏幕上看到，当我尝试将内容导入Excel时，不会导入任何内容。因此，尽管URLDownloadToFile在大多数情况下都可以使用，但它不能与Yahoo组合网页一起使用。我的问题是： 1）它可以帮助改变函数的参数（参数1 = pcaller？）。但是怎么样？ 2）vba中是否有任何其他已知的方法可以保存网页而不是逐行阅读（尝试过这个也不起作用）？这是我尝试的两种方法：

  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

在等待答案的同时，我继续搜索其他解决方案，并找到一个适用于我的情况。这不是我一直在寻找的答案，但它解决了我的问题。我没有使用雅虎投资组合页面，而是使用Yahoo Finance API（see [Alternative to google finance api (closed)）。网址

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

创建一个可下载的逗号分隔文本文件（.csv），可以直接在VBA中存储或评估。 [symbol1 ...]是您要分析的股票的股票代码符号 {format code}是一系列字母，用于描述您想要查看的数据类型（http://www.jarloo.com/yahoo_finance/中的完整列表）

因为我只需要股票代码和没有时间的最后价格，我的格式代码是“sl1”。但是有一个问题，或实际上有两个。第一个（由雅虎强加）是允许的最大符号数为200，如果您在短时间内拨打过多电话，您的IP可能会被阻止。因此，虽然格式列表包含实时数据的代码，但可能无法以这种方式获得实时流数据。

第二个是我在下面的代码中使用的 QueryTables.Add 方法给出的，它将URL限制为255个字符。如果URL字符串较长，则会发生运行时错误。这意味着第二个限制将在达到200个符号之前发生。

以下代码通过为所有符号创建所需数量的调用来解决循环结构中的此问题，其中每个调用使用长度小于256个字符的URL。在我的测试中，我使用了一个带有两个工作表test和pf1的工作簿test.xlsm。 PF1包含从第3行开始在A列中获取的所有符号的列表。工作表“test”中的第一行在D1（= 3）中具有这些数据的起始行，在E1中具有最后一个符号的行。

我的sub有一个外部循环，它根据需要经常重复内部循环以获取所有符号。

内部循环为调用创建URL1，将尽可能多的符号添加到URL的基本部分，条件是它必须保持在256个字符以下。一旦URL完成，指向符号的实际指针list保存为“First”并获取数据。然后，为列表中的下一批数据计算新URL。

获取所有数据后，结果表中的行高和列长被重置，因为我注意到它们在操作期间被更改（不知道原因）。

我还注意到一些价格值，以美国十进制格式（带小数“点”）可能会在查询过程中丢失点。不确定这是由于我的数字格式（欧洲，“逗号”）还是查询本身的某些问题。理想情况下，我的数字格式不应该有任何影响，因为下载的数据应该都是TEXT。无论如何，这使得有必要使用所有符号的近似价格值列表来校正最终的异常值。此更正不包含在此子目录中。

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

使用URLDownloadToFile从Web下载html文件会创建空文件

1 个答案: