【问题标题】:Message box not always visible消息框并不总是可见
【发布时间】:2014-01-30 02:54:13
【问题描述】:

我有以下 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

我遇到的问题是,大多数时候我不会出现任何消​​息框,同时也没有下载任何内容。你能帮我一直得到消息框吗?

非常感谢!

【问题讨论】:

  • 我不知道将整个路径放入您公司的目录是否是一个明智的选择。不是说我们可以访问它,而是……随便。两件事:你的download_path 是错误的。您应该在文件夹级别停止,除非您的 Download_File 子例程/函数将 download_path 作为下载文件的最终保存名称。其次,InStr 操作过度。您确定您正在下载的文件总是名为T080102.xls吗?请澄清这一点并提供Download_File 的代码。我认为它有时是成功的,但有些东西阻碍了它。
  • 非常感谢,还删除了公司目录:) 是的,该文件将始终命名为 T080102.xls。这也是正确的,有时它是成功的,有时它不是令人讨厌的部分!下面也是Download_File
  • 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 '打开套接字获取网站 oXMLHTTP.Send '发送请求 '等待请求完成 Do While oXMLHTTP.readyState 4 DoEvents Loop oResp = oXMLHTTP.responseBody '返回结果作为字节数组
  • '创建本地文件并将结果保存到其中 vFF = FreeFile If Dir(vLocalFile) "" Then Kill vLocalFile Open vLocalFile For Binary As #vFF Put #vFF, , oResp Close #vFF '清除memory Set oXMLHTTP = Nothing End Function
  • 抱歉,这是我在这里的第一篇文章!添加它!

标签: vba excel


【解决方案1】:

在我这边测试了你的代码,我看不到任何错误。我已经下载了一百次了,它并没有坏掉。不过,我做了一些小的修改。

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

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。这样,它将等待您的输入而不是中断。

URL 也有细微的变化。将 section2 更改为 section8,因为这是您想要的表格(不会影响任何事情,恕我直言)。

如果这有帮助,请告诉我们。

【讨论】:

  • 非常感谢。目前似乎工作正常:)
猜你喜欢
  • 2016-02-19
  • 1970-01-01
  • 1970-01-01
  • 2019-02-20
  • 1970-01-01
  • 1970-01-01
  • 2019-07-12
  • 1970-01-01
  • 2011-02-10
相关资源
最近更新 更多