VBA http.send无法正常工作

时间:2015-01-18 17:56:28

标签: vba excel-vba excel

我在yahoo.finance网站上找到了使用csv文件非常有用的VBA代码。它在家里的PC上运行正常,但是当我在工作中尝试它时它会冻结在一起:

Http.Send

发送http请求是刚刚阻止还是其他原因?有什么方法可以解决它吗?

以下excel文件中的代码和数据:

Private Sub REFRESH_Click()

Dim W As Worksheet
Set W = ActiveSheet

Dim Last As Integer
Last = W.Range("A10000").End(xlUp).Row
If Last = 1 Then Exit Sub

Dim Symbols As String
Dim i As Integer

For i = 2 To Last

Symbols = Symbols & W.Range("A" & i).Value & "+"

Next i

Cells(10, 10).Value = Symbols

Symbols = Left(Symbols, Len(Symbols) - 1)

Dim URL As String
URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=snl1ab"

Cells(11, 10).Value = URL


Dim Http As New WinHttpRequest
Http.Open "GET", URL, False
Http.Send


Dim Resp As String
Resp = Http.ResponseText

Dim Lines As Variant
Lines = Split(Resp, vbNewLine)

Dim Sline As String
Dim Values As Variant
For i = 0 To UBound(Lines)
Sline = Lines(i)
If InStr(Sline, ",") = 0 Then End
Values = Split(Sline, ",")

W.Cells(i + 2, 2).Value = Values(1)
W.Cells(i + 2, 3).Value = Values(UBound(Values) - 2)
W.Cells(i + 2, 4).Value = Values(UBound(Values) - 1)
W.Cells(i + 2, 5).Value = Values(UBound(Values))

Next i


End Sub

Excel文件中的数据:

符号名称价格询价 IBM
USB
MSFT

我将非常感谢您的帮助。 亲切的问候

1 个答案:

答案 0 :(得分:-1)

Excel可以导入自己的数据。它不需要你的帮助。

您的代码省略了任何错误检查。因此,无论发生什么,你都不会阅读它。

所以要在Excel中导入网页,Alt + D,D,W。

您可以导入到新工作表,只需在主工作表中引用它即可。 (对CSV无效,它们直接转到主表)。

这是一些执行错误检查的代码。

将以下行放入文本文件中。将其命名为safetyscanner.vbs并放在桌面上。

适用于32位Windows

 Set fso = CreateObject("Scripting.FileSystemObject")
 Set Outp = Wscript.Stdout
 On Error Resume Next
 Set File = WScript.CreateObject("Microsoft.XMLHTTP")
 File.Open "GET", "http://definitionupdates.microsoft.com/download/definitionupdates/safetyscanner/x86/msert.exe", False
 File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
 File.Send
 If err.number <> 0 then 
  Outp.writeline "" 
  Outp.writeline "Error getting file" 
  Outp.writeline "==================" 
  Outp.writeline "" 
  Outp.writeline "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description 
  Outp.writeline "Source " & err.source 
  Outp.writeline "" 
  Outp.writeline "HTTP Error " & File.Status & " " & File.StatusText
  Outp.writeline  File.getAllResponseHeaders
  Outp.writeline Arg(1)
 End If

On Error Goto 0

 Set BS = CreateObject("ADODB.Stream")
 BS.type = 1
 BS.open
 BS.Write File.ResponseBody
 BS.SaveToFile "c:\users\safetyscanner.exe", 2