excel vba 从互联网下载文本文件，每 5 分钟更新一次答案

【问题标题】：excel vba download text file from the internet that update every 5 minutesexcel vba 从互联网下载文本文件，每 5 分钟更新一次
【发布时间】：2018-10-11 10:01:29
【问题描述】：

我想从这个链接下载一个文件： https://www.hko.gov.hk/tide/marine/data/ALL.txt

此文件每 5 分钟自行更新一次。所以我继续创建一个 excel VBA，然后使用调度程序每 5 分钟激活一次这个 excel 文件。然而不知何故，我下载到电脑中的文件并没有每 5 分钟更新一次。如果我使用chrome或IE打开，内容保持不变，与文本文件不同。

以下是我从网上复制的一个非常典型的脚本。

Function DownloadFile(link As String)
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", link, False, "username", "password"
WinHttpReq.send

myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile ThisWorkbook.Path & "\raw\" & "temp.csv", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If

End Function

【问题讨论】：

旁注：上面应该是一个子。您不需要用户名和密码参数，并且可以删除此行：myURL = WinHttpReq.responseBody。并且应该声明所有变量。

标签： excel vba

【解决方案1】：

可能存在缓存。尝试以下方法，其中添加了 requestHeader 以尝试减轻潜在的缓存。另一种常见的替代方法是在 URL 末尾添加一个随机数似乎不适用于此站点。

Option Explicit

Public Sub test()
    Dim i As Long
    For i = 1 To 3
        DownloadFile "https://www.hko.gov.hk/tide/marine/data/ALL.txt"
        Debug.Print Now
        Application.Wait Now + TimeSerial(0, 5, 0)
    Next
End Sub

Public Sub DownloadFile(ByVal link As String)
    Dim WinHttpReq As Object, oStream  As Object
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    With WinHttpReq
        .Open "GET", link, False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send

        Debug.Print StrConv(.responsebody, vbUnicode)

        If WinHttpReq.Status = 200 Then
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1
            oStream.Write .responsebody
            oStream.SaveToFile ThisWorkbook.Path & "\raw\" & "temp.csv", 2 ' 1 = no overwrite, 2 = overwrite
            oStream.Close
        End If

    End With

End Sub

【讨论】：

@QHarr 非常好。有没有办法在等待的执行过程中使用excel？我尝试了 DoEvents，但似乎对我不起作用。
@YasserKhalil 嗨 - 你是什么意思？
@QHarr 我的意思是在等待期间，excel 被冻结，我想知道是否可以在执行和等待期间使 excel 可供使用
@YasserKhalil DoEvents 是通常的方式。另外，发现了这个：reddit.com/r/excel/comments/4sc3ig/…
虽然我用过 Excel，但它仍然冻结。我认为Application.Wait 部分是原因。

【解决方案2】：

QHarr 的回答对我不起作用。我尝试了许多解决方案，但似乎它们不适用于 VBA，或者需要早期绑定调用，我不喜欢这种方法，所以我想出了以下方法。简单地说，我们将尝试从缓存中删除相同的 url/文件，然后继续下载文件：

'--- copy this to the top of the module (below Option Explicit) ---
'Declaration for deleting a file from the cache:
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet.dll" Alias _
    "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

函数修改如下：

Function DownloadFile(link As String)
    Dim WinHttpReq As Object
    
    'First delete the file from cache:
    'On Error Resume Next
    DeleteUrlCacheEntry url
    
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    
    WinHttpReq.Open "GET", link, False, "username", "password"
    WinHttpReq.send
    
    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile ThisWorkbook.Path & "\raw\" & "temp.csv", 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If

End Function

【讨论】：