如何使用VBA从网站获取CSV

时间:2017-12-19 23:01:54

标签: excel vba excel-vba csv

您好我从vba中抓取excel表时遇到问题

我的代码如下:

Sub transfercsv()

sCSVLink = "http://ets.aeso.ca/Market/Reports/Manual/Operations/prodweb_reports/wind_power_forecast/WPF_ShortTerm.csv"
sfile = "options_code_list.csv"
ssheet = "CSV Transfer"


Dim myURL As String
myURL = "http://ets.aeso.ca/Market/Reports/Manual/Operations/prodweb_reports/wind_power_forecast/WPF_ShortTerm.csv"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.ResponseBody
    oStream.SaveToFile ("C:\file.csv")
    oStream.Close

End If

现在,当代码运行时,它会切断我想要保存的数据。对此有何解决方案?

由于

3 个答案:

答案 0 :(得分:2)

Dim wb
Set wb = Workbooks.Open("http://ets.aeso.ca/Market/Reports/Manual/Operations/" & _
                        "prodweb_reports/wind_power_forecast/WPF_ShortTerm.csv")

Debug.Print wb.Sheets(1).UsedRange.Rows.Count '>> 18

答案 1 :(得分:0)

我无法找到数据被截止的问题,似乎任何人都可以运行此报告。

我清理了方法,因为似乎有一些不需要的变量和其他一些问题。修改后的代码。

<强>代码

Option Explicit

Sub SOExample()
    Const OutputFilePath As String = "C:\Users\Ryan\Desktop\file.csv"
    Const myURL As String = "http://ets.aeso.ca/Market/Reports/Manual/Operations/prodweb_reports/wind_power_forecast/WPF_ShortTerm.csv"
    Const adTypeBinary = 1
    Dim response() As Byte

    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", myURL, False
        .Send
        response = .ResponseBody
    End With

    If UBound(response) > 0 Then

        'Delete the file before saving?
        With CreateObject("Scripting.FileSystemObject")
            If .FileExists(OutputFilePath) Then Kill OutputFilePath
        End With

        With CreateObject("ADODB.Stream")
            .Open
            .Type = adTypeBinary
            .Write response
            .SaveToFile (OutputFilePath)
            .Close
        End With

    End If

End Sub

答案 2 :(得分:0)

以下是您尝试的几个想法。

Sub DownloadFile()

Dim myURL As String
myURL = "http://www.asx.com.au/data/options_code_list.csv"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.ResponseBody
    oStream.SaveToFile "C:\Users\Excel\Desktop\Coding\Microsoft Excel\Bank of China\downloadCSV.csv", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If

End Sub


Sub transfercsv()
sCSVLink = "http://www.asx.com.au/data/options_code_list.csv"
sfile = "options_code_list.csv"
ssheet = "CSV Transfer"

Set wnd = ActiveWindow
Application.ScreenUpdating = False
Sheets(ssheet).Cells.ClearContents
Workbooks.Open Filename:=sCSVLink
Windows(sfile).Activate
ActiveSheet.Cells.Copy
wnd.Activate
Sheets("CSV Transfer").Paste
Application.DisplayAlerts = False
Windows(sfile).Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub