繁体   English   中英

消息框并非始终可见

[英]Message box not always visible

我有以下VBA代码,该代码旨在从Web下载文件,给我一条消息“从...下载数据”,下载后给我一条消息“下载到...”。 这是我的代码:

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

我遇到的问题是,在大多数情况下,我不会出现任何消​​息框,同时也没有任何下载。 您能否一直帮助我以获得消息框?

非常感谢你!

我在最后测试了您的代码,但看不到任何错误。 我已经下载了一百次,而且它没有损坏。 但是,我做了一些小的修改。

将主子例程更改为以下内容:

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

基本上,我只是更改了一件事:消息框将在下载文件之前等待您的输入。 请注意If MsgBox(...) = vbOKOnly我是如何做的。 这样,它将等待您的输入而不会中断。

网址也做了些微更改。 section2更改为section8 ,因为这是您想要的表(恕不影响任何内容,恕我直言)。

让我们知道是否有帮助。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM