我正在使用以下代码从 html 页面获取数据,该页面从网络存储在我电脑上的文件夹中。我在另一个可以完美运行的模块中使用了基本相同的代码,所以我不明白为什么它在这个单独的例程中不起作用。我需要单独例程的原因是因为原始代码嵌入在一个非常复杂的大例程中,我不能运行它只是为了检查特定文件的数据,顺便说一句,在更复杂的代码中已经对其进行了分析,没有任何问题套路。(下面是原始代码进行比较)。
Dim Act As Worksheet, ActSt As Worksheet
On Error GoTo errorhandler
Set Actbl = Workbooks("table.xlsm")
Set ActSt = Actbl.Worksheets("act.st.") 'query will be stored here
'some code to define path &filename
............
' Create URL
URL = path & filename
' Create Web Query & refresh it
If Len(Dir(URL)) > 0 Then 'found the file
ActSt.Activate
ActSt.Cells.Clear 'clear sheet "act.st."
'set up a table import (the URL; tells Excel that this query comes from an html file)
Set qt = ActSt.QueryTables.Add( _
Connection:="URL;" & filename, Destination:=ActSt.Range("A4")) 'save data in "act.st."
With qt
.WebConsecutiveDelimitersAsOne = False
.WebDisableDateRecognition = False
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebSelectionType = xlEntirePage
.WebSingleBlockTextImport = False
.RefreshStyle = xlOverwriteCells
.Refresh 'get the data
End With
ActSt.QueryTables.Item(1).Delete 'delete the created query, otherwise they accumulate
Else
MsgBox "File not found"
Exit Sub
End If
errorhandler:
answer = MsgBox("Error " & Err.Number & ": " & Err.Description & ". Exit?", vbYesNo)
If answer = vbYes Then Exit Sub
Resume
尽管“If Len(Dir(URL)) > 0 Then”行确保文件存在,但当代码到达“刷新”时出现错误。消息是:
错误 1004:此站点的地址无效。检查地址,然后重试。出口?
(文本可能与英语操作系统略有不同,因为实际上它是西班牙语,这只是我的翻译)
我不明白当文件明显存在并且用“Dir(URL)”检测到时地址如何“无效”以及如何解决这个问题。
与这个问题相关的第二个问题涉及我之前在测试此代码时遇到的另一个错误 1004。当我运行代码时,我在浏览器中打开了文件,我收到一个 1004 错误,上面写着“应用程序定义的错误”。我想这意味着“其他用户正在使用文件”之类的东西。有没有办法区分这种 1004 错误,以便错误消息更具体?像“错误子编号”之类的东西?1004 非常通用。
感谢所有可以帮助我找到解决方案的人,尤其是第一个问题。
这是我为较短的例程复制并稍微修改的原始代码:
If Len(Dir(filename)) > 0 Then 'found the file
GetFile = True
ws1.Cells.Clear 'clear sheet "act.st."
'set up a table import (the URL; tells Excel that this query comes from an html file)
Set qt = ws1.QueryTables.Add( _
Connection:="URL;" & filename, Destination:=ws1.Range("A4")) 'save data in "act.st."
With qt
.WebConsecutiveDelimitersAsOne = False
.WebDisableDateRecognition = False
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebSelectionType = xlEntirePage
.WebSingleBlockTextImport = False
.RefreshStyle = xlOverwriteCells
.Refresh 'get the data
End With
ws1.QueryTables.Item(1).Delete 'delete the created query, otherwise they accumulate
Else
GetFile = False
End If