excel - Webページのリンクボタンをクリックし、vbaを使用してcsvファイルをダウンロードして保存します

Question

私はこのページからテーブル/データを取得するためにさまざまなアプローチを試みてきましたがExcel VBA、結果はありませんでした。私の最後の試みは、を使用Excel VBAしてWebページをクリックして開き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 がダウンロードされるため、そこにデータがあります。問題はウェブサイトにある可能性があると思います。

CSV ファイルの URL がわかっている (または導出できる) 場合は、QueryTables メソッドを使用できます。指定した URL では、「表示するデータがありません」というエラー メッセージが表示され、「Web サービスの呼び出し中にエラーが発生しました」というエラー メッセージが表示されます。

fullURLこれのほとんどすべては、手動で入力された文字列といくつかの基本的なエラー処理を除いて、QueryTables を使用してマクロを記録することによるものです。

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