0

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!

WGS
  • 13,969
  • 4
  • 48
  • 51
  • I don't know if putting in the whole path for your company's directory is such a wise choice. Not that we can access it but... Whatever. Two things: your `download_path` is wrong. You should stop at folder level, unless your `Download_File` subroutine/function takes in `download_path` as the download file's eventual saved name. Second, `InStr` is operating on overkill. Are you sure that file you are downloading is **always** named `T080102.xls`? Kindly clarify this and provide the code for `Download_File` as well. I'm thinking it's successful at times but something's hampering it. – WGS Jan 29 '14 at 16:20
  • Thank you very much, also removed the company directory :) Yes, the file will always be named T080102.xls. It is also correct that sometimes it is successful and sometimes it is not which is the annoying part! below is the Download_File as well – user3249608 Jan 29 '14 at 17:20
  • 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 – user3249608 Jan 29 '14 at 17:24
  • '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 – user3249608 Jan 29 '14 at 17:25
  • Kindly move your codeblocks to the original post. It's a pain to read and debug it in the comments area. :) – WGS Jan 29 '14 at 17:43
  • 1
    Apologies, it is my first post in here! added it! – user3249608 Jan 29 '14 at 17:46

1 Answers1

0

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.

WGS
  • 13,969
  • 4
  • 48
  • 51