消息框并非始终可见

Question

I have the following VBA code that it is intended to download a file from the web, give me a message "Downloading Data from ..." and as soon as downloaded give me a message "Downloaded to ...". Here is my code:

Sub DownloadFileFromWeb()
Dim IE As Object
Dim links As Variant, lnk As Variant
Dim download_path As String
download_path = "\\xxxxx\Save Raw File here.xls"
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://www.hkma.gov.hk/eng/market-data-and-statistics/monthly-statistical-bulletin/table.shtml#section2" 'load web page
While IE.Busy
  DoEvents  'wait until IE is done loading page.
Wend
Set links = IE.document.getElementsByTagName("a")
For Each lnk In links
     If Len(lnk.href) > 4 And Right(lnk.href, 4) = ".xls" And InStr(1, lnk.href, "http://www.hkma.gov.hk/media/eng/doc/market-data-and-statistics/monthly-statistical-bulletin/T080102.xls") <> 0 Then
            MsgBox "Downloading Data from " & lnk.href
            Download_File lnk.href, download_path
            MsgBox "Downloaded to - " & download_path
            Exit For
     End If
Next
End Sub

Function Download_File(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte

Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", vWebFile, False 'Open socket to get the website
oXMLHTTP.Send 'send request

'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop

oResp = oXMLHTTP.responseBody 'Returns the results as a byte array

'Create local file and save results to it
vFF = FreeFile
If Dir(vLocalFile) <> "" Then Kill vLocalFile
Open vLocalFile For Binary As #vFF
Put #vFF, , oResp
Close #vFF

'Clear memory
Set oXMLHTTP = Nothing
End Function

The problem i have with this one is that most of the times i will not get any message box appearing and nothing gets downloaded in the meantime. Can you please help me in order to get the message box all of the time?

Thank you very much!

Answer 1

Tested your code on my end and I can see no errors. I've downloaded it like a hundred times already and it doesn't break. However, I made some minor modifications.

Change your main subroutine to the following:

Sub DownloadFileFromWeb()
Dim IE As Object
Dim links As Variant, lnk As Variant
Dim download_path As String
download_path = "C:\...\SavedFile.xls" 'Modify.
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://www.hkma.gov.hk/eng/market-data-and-statistics/monthly-statistical-bulletin/table.shtml#section8" 'load web page
While IE.Busy
  DoEvents  'wait until IE is done loading page.
Wend
Set links = IE.document.getElementsByTagName("a")
For Each lnk In links
     If Len(lnk.href) > 4 And Right(lnk.href, 4) = ".xls" And InStr(1, lnk.href, "T080102.xls") <> 0 Then
            If MsgBox("Downloading Data from " & lnk.href, vbOKOnly) = vbOK Then
                Download_File lnk.href, download_path
                MsgBox "Downloaded to - " & download_path
                Exit For
            End If
     End If
Next
End Sub

Basically, I just changed one thing: the message box will wait for your input before it downloads the file. Notice how I did If MsgBox(...) = vbOKOnly . This way, it will wait for your input and not break.

Minor change as well to URL. Changed section2 to section8 , since that's the table you want (not going to affect anything, IMHO).

Let us know if this helps.