URLDownloadToFile循环中的函数不起作用，因为即使没有要下载的文件，函数也会返回0

Question

我正在建立自己的excel表来跟踪我的投资。我有这个证券交易所网站的链接，它有一个zip文件，其中包含最近一个交易日交易数据的CSV文件。 zip文件的名称是动态的，格式为“eq_csv.zip，其中ddmmyy是数据所属的交易日期。因此，可用文件可能是当天或2-4天，如果市场已经关闭。

每次打开excel文件时，我都会构建一个模块来在线检查，以获取最新的在线数据。下面给出的代码应该从当前日期开始循环并向后移动1天，直到我下载了有效的zip文件。例如，如果当前日期是4月28日（星期日），如果在线资源上的文件是4月26日（星期五）（eq260413_CSV.zip），那么我的循环应该经历3次迭代（2没有文件消息和一个文件下载了msg）并下载文件eq260413_CSV.zip。由于文件eq280413_CSV.zip或eq290413_CSV.zip在提到的在线链接中不存在，我希望返回错误并继续循环。在运行代码时，我发现该函数只是在第一次传递期间创建了一个没有数据的虚拟文件eq280413_CSV.zip，并将值0返回到iRet，从而退出循环。任何人都可以帮助/抛出一些光线

Sub DownloadFile()

Worksheets("Online Equity Data").Activate

Dim StrURL As String
Dim strPath As String
Dim dDate As Date
Dim iRet As Long

dDate = Now() + 1
iRet = 1
vFolderName = "C:\Users\Deep\Documents\Finances\Test\"

Do While iRet <> 0
    dDate = dDate - 1
    StrURL = "http://www.bseindia.com/download/BhavCopy/Equity/eq" & Format(dDate, "ddmmyy") & "_csv.zip"
    strPath = vFolderName & "eq" & Format(dDate, "ddmmyy") & "_csv.zip"
    iRet = URLDownloadToFile(0, StrURL, strPath, 0, 0)
     If iRet= 0
        MsgBox "File eq" & Format(dDate, "ddmmyy") & "_csv.zip Downloaded"
    Else
        MsgBox "No File Named eq" & Format(dDate, "ddmmyy") & "_csv.zip"  
    End If
Loop

'More code Here to unzip and import the downloaded data

End Sub()

Answer 1

当文件/ URL不存在时，不应使用URLDownloadToFile文件API。

您必须首先检查网址是否有效，然后使用URLDownloadToFile（如果适用）。

使用Leith Ross撰写的以下函数（从HERE中选取）

'Written: March 15, 2011
'Author:  Leith Ross

Public PageSource As String
Public httpRequest As Object

Function GetURLStatus(ByVal URL As String, Optional AllowRedirects As Boolean)
    Const WinHttpRequestOption_UserAgentString = 0
    Const WinHttpRequestOption_EnableRedirects = 6

    On Error Resume Next
    Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    If httpRequest Is Nothing Then
        Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5")
    End If
    Err.Clear
    On Error GoTo 0

    httpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
    httpRequest.Option(WinHttpRequestOption_EnableRedirects) = AllowRedirects

    'Clear any pervious web page source information
    PageSource = ""

    'Add protocol if missing
    If InStr(1, URL, "://") = 0 Then
        URL = "http://" & URL
    End If

    'Launch the HTTP httpRequest synchronously
    On Error Resume Next
    httpRequest.Open "GET", URL, False
    If Err.Number <> 0 Then
      'Handle connection errors
        GetURLStatus = Err.Description
        Err.Clear
        Exit Function
    End If
    On Error GoTo 0

    'Send the http httpRequest for server status
    On Error Resume Next
    httpRequest.Send
    httpRequest.WaitForResponse
    If Err.Number <> 0 Then
      ' Handle server errors
        PageSource = "Error"
        GetURLStatus = Err.Description
        Err.Clear
    Else
      'Show HTTP response info
        GetURLStatus = httpRequest.Status & " - " & httpRequest.StatusText
      'Save the web page text
        PageSource = httpRequest.responsetext
    End If
    On Error GoTo 0
End Function

当网址正常时，你会得到类似这样的内容

如果不是，你会得到类似的东西

所以你需要做的就是找200 - OK，如果你得到了，那就用URLDownloadToFile下载文件。