Question

我创建了一个使用vba代码访问yahoo网站获取股票数据的Excel。

excel大部分时间都可以正常工作，但有时（我找不到规则/动机）它不会从雅虎获取数据。

奇怪的是，如果我一步一步地使用调试器，它可以工作，但如果我启动宏它不起作用，我无法获取数据。

你有什么想法吗？

谢谢，

吉安卡洛

在sub下面我用t检索数据......

Sub StrongestSmallCaps()
Dim frequency As String
Dim numRows As Integer
Dim LastRow As Integer
Dim stockTicker As String
Dim IndR As Integer
Dim Simbolo As String
Dim rsi As String
Dim ShortInter As Boolean
Dim NonIncr As Boolean
Worksheets("GreenLine").Select
LastRow = ActiveSheet.Cells(Rows.Count, "h").End(xlUp).Row
frequency = "d"



'Cancella contenuti celle stocastici
Range("j2:k70").Clear
Range("j2:k70").Select
Selection.Style = "Stocastic"

Range("i2:i70").Clear
Range("i2:i70").Select
Selection.Style = "Tick"
Application.Wait Now + TimeValue("00:00:03")
IndR = 2
'Loop through all tickers
For Ticker = 2 To LastRow

    'Application.Wait Now + TimeValue("00:00:03")
    stockTicker = Worksheets("GreenLine").Range("$h$" & Ticker)

    If stockTicker = "" Then
        GoTo NextIteration
    End If

    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = stockTicker

    Cells(1, 1) = "Stock Quotes for " & stockTicker
    Call DownloadStockQuotes(stockTicker, Worksheets("GreenLine").Range("$b$500"), Worksheets("GreenLine").Range("$b$600"), "$a$2", frequency)

    'Application.Wait Now + TimeValue("00:00:03")
    Columns("a:a").TextToColumns Destination:=Range("a1"), DataType:=xlDelimited, _
                                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                 Semicolon:=False, Comma:=True, Space:=False, other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
    Sheets(stockTicker).Columns("A:G").ColumnWidth = 10


    LastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
    If LastRow < 3 Then
        Application.DisplayAlerts = False
        Sheets(stockTicker).delete
        GoTo NextIteration
        Application.DisplayAlerts = True
    End If

    Rows("1:1").Select
    Selection.delete Shift:=xlUp
    Columns("B:B").Select
    Selection.delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.delete Shift:=xlToLeft

    Rows("2:2").Select
    Selection.INSERT Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    'CALCOLA STOCHASTIC
    Worksheets("GreenLine").Select
    Range("Cb100:Cm122").Select
    Selection.Copy
    Worksheets("GreenLine").Select
    Sheets(stockTicker).Select
    Range("e1").Select
    ActiveSheet.Paste


    If Cells(3, 8) < 20 Then
        Worksheets("GreenLine").Select

        Cells(IndR, 9) = stockTicker
        Cells(IndR, 10) = "BUY"
        Cells(IndR, 10).Select
        Selection.Style = "Oversold"
        Application.DisplayAlerts = False
        Sheets(stockTicker).delete
        Application.DisplayAlerts = True

        'CALCOLA RSI
        'Sheets(stockTicker).Select

        'If Cells(3, 16) < 20 Then
        '     rsi = Cells(3, 16)
        '     Worksheets("GreenLine").Select
        '
        '     Cells(IndR, 9) = stockTicker
        '     Cells(IndR, 11) = "OVS"
        '     Cells(IndR, 11).Select
        '     Selection.Style = "Oversold"
        '     Selection.Style = "Comma"
        '     IndR = IndR + 1

        '     Application.DisplayAlerts = False
        '     Sheets(stockTicker).delete
        '     Application.DisplayAlerts = True
        'Else
        '     IndR = IndR + 1
        '     Application.DisplayAlerts = False
        '     Sheets(stockTicker).delete
        '     Application.DisplayAlerts = True
        'End If
    Else
        Application.DisplayAlerts = False
        Sheets(stockTicker).delete
        Application.DisplayAlerts = True
        'Sheets(stockTicker).Select
        'If Cells(3, 16) < 20 Then
        '     rsi = Cells(3, 16)
        '     Worksheets("GreenLine").Select
        '
        '     Cells(IndR, 9) = stockTicker
        '     Cells(IndR, 11) = "OVS"
        '     Cells(IndR, 11).Select
        '     Selection.Style = "Oversold"
        '     Selection.Style = "Comma"
        '
        '     IndR = IndR + 1
        '     Application.DisplayAlerts = False
        '     Sheets(stockTicker).delete
         '    Application.DisplayAlerts = True
        'Else
        '     Application.DisplayAlerts = False
        '     Sheets(stockTicker).delete
        '     Application.DisplayAlerts = True
        'End If
    End If

NextIteration:
Next Ticker

ErrorHandler:

Worksheets("GreenLine").Select
Application.ScreenUpdating = True


Range("h2:h70").Clear
Range("h2:h70").Select
Selection.Style = "Normal"

E

nd Sub

Sub DownloadStockQuotes(ByVal stockTicker As String, ByVal startDate As Date, ByVal endDate As Date, ByVal DestinationCell As String, ByVal freq As String)

Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
StartMonth = Format(Month(Date) - 8, "00")
StartDay = Format(Day(Date), "00")
StartYear = Format(Year(Date), "00")

EndMonth = Format(Month(Date) - 1, "00")
EndDay = Format(Day(Date), "00")
EndYear = Format(Year(Date), "00")
Application.Wait Now + TimeValue("00:00:03")
qurl = "URL;http://table.finance.yahoo.com/table.csv?s=" + stockTicker + "&a=" + StartMonth + "&b=" + StartDay + "&c=" + StartYear + "&d=" + EndMonth + "&e=" + EndDay + "&f=" + EndYear + "&g=" + freq + "&ignore=.csv"
Application.Wait Now + TimeValue("00:00:03")
On Error GoTo ErrorHandler:
With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=Range(DestinationCell))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "20"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With
ErrorHandler:

End Sub

Answer 1

我的工作是先发出此命令 On Error Resume Next'这应该会超过1004错误，但我的错误列中将显示No Data

然后我获取数据后，检查是否有任何数据，如果没有，我再次运行查询。由于某些未知原因，它随机失败，几乎总是第二次工作。

但我希望你已经解决了你的问题，因为很久以前就发布了这个问题。

雅虎查询不起作用

1 个答案: