excel - 单击网页中的链接按钮并使用 vba 下载并保存 csv 文件

Question

我一直在尝试所有不同的方法来使用此页面Excel VBA获取表/数据，但没有任何结果。我的最后一次尝试是使用Excel VBA, 打开网页，单击CSV并将文件保存在给定位置。

任何帮助将不胜感激。

Answer 1

这是另一个例子。这应该可以让您到达“保存”对话框。

Sub AnotherExample()
Dim URL As String
Dim ieApp As Object
Dim ieDoc As Object
Dim ieForm As Object
Dim ieObj As Object
Dim objColl As Collection

URL = "http://www.bmreports.com/bsp/BMRSSystemData.php?pT=DDAD&zT=N&dT=NRT"

Set ieApp = CreateObject("InternetExplorer.Application")
ieApp.Visible = True
ieApp.Navigate URL

While ieApp.Busy
    'wait...
Wend

Set ieDoc = ieApp.Document
For Each ele In ieApp.Document.getElementsByTagname("span")

    If ele.innerHTML = "CSV" Then
        DoEvents
        ele.Click
        'At this point you need to Save the document manually
        ' or figure out for yourself how to automate this interaction.
    End If
Next

ieApp.Quit
End Sub

我不知道如何使这种“保存”交互自动化，尽管我 100% 确定它可以完成，但我根本不想花时间学习如何为你做。

Answer 2

我无法从该链接下载任何 CSV，该站点似乎返回错误。但是 XML 下载，所以那里有数据。我认为问题可能出在网站上。

您可以使用 QueryTables 方法对 CSV 文件的 URL 已知（或可以导出）。您提供的 URL 产生“无数据显示”和错误消息“调用 Web 服务时出错”

几乎所有这些都来自使用 QueryTables 记录宏，除了手动输入的字符串fullURL和一些基本的错误处理。

Private Sub OpenURL()
'Opens the URL and splits the CSV data in to cells.
Dim fullURL as String '< - variable to contain the URL of the CSV you are attempting to download

'Example URL for CSV download from Yahoo Finance, modify as needed.
fullURL = "http://ichart.finance.yahoo.com/table.csv?s=GM&a=10&b=18&c=2010&d=06&e=27&f=2012&g=d&ignore=.csv"


'This opens the webpage
On Error GoTo ErrOpenURL
With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;" & fullURL, Destination:=Range("A1"))
    .Name = fullURL
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingAll
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

ExitOpenURL:
Exit Sub 'if all goes well, you can exit

'Error handling...

ErrOpenURL:
Err.Clear
MsgBox "The URL you are attempting to access cannot be opened.",vbCritical
Resume ExitOpenURL


End Sub