Question

我一直在尝试使用Excel VBA从 this page 获取表格/数据的所有不同方法，但没有任何结果。我的最后一次尝试是使用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

我不知道如何自动化这种“保存”互动，虽然我百分之百确定它可以做到，但我并不倾向于花时间学习如何为你做这些。

Answer 2

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

您可以使用CSV文件的URL的QueryTables方法已知（或可以派生）。您提供的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

单击网页中的链接按钮，然后使用vba下载保存csv文件

2 个答案: