如何使用VBA从网站获取CSV

Question

您好我从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

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

谢谢

Answer 1

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

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

码

---

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

Answer 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

Answer 3

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

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