Laufzeitfehler 1004 bei VBA Code

[boje]

Hallo,

ich habe ein VBA script eingebunden, um Aktienkurse von yahoo Finance abzurufen. Bisher lief das immer. Auf einmal bekomme ich aber eine Fehlermeldung:

Laufzeitfehler 1004: Anwendungs- oder objektdefinierter Fehler. Der Fehler tritt bei:  .Refresh BackgroundQuery:=False auf.

Ich habe den code hier eingefügt. Versteht jemand, wo das Problem liegt?

Code:

Sub GetData()
   Dim QuerySheet As Worksheet
   Dim DataSheet As Worksheet
   Dim qurl As String
   Dim i As Integer
   Dim j As Integer
   Dim k As Integer
  
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Application.Calculation = xlCalculationManual
  
   Set DataSheet = ActiveSheet
  
   Range("C7").CurrentRegion.ClearContents
   i = 7
   qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
   i = i + 1
   While Cells(i, 1) <> ""
      qurl = qurl + "+" + Cells(i, 1)
      i = i + 1
   Wend
   qurl = qurl + "&f=" + Range("C2")
   Range("c1") = qurl

QueryQuote:
   With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
      .BackgroundQuery = True
      .TablesOnlyFromHTML = False
      
      .Refresh BackgroundQuery:=False
      .SaveData = True
   End With
  
   j = Range("A7").End(xlDown).Row
  
   For k = 7 To j
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Common Stoc", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Common St", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Co St", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Co", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. (The)", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Com", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc.", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Incorporated C", "")
      Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Incorporated", "")
   Next
  
   Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
       Semicolon:=False, Comma:=True, Space:=False, other:=False
  
   'turn calculation back on
   Application.Calculation = xlCalculationAutomatic
   Application.DisplayAlerts = True
   '    Range("C7:H2000").Select
   '    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
       '        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   Columns("C:C").ColumnWidth = 25
   Rows("7:2000").RowHeight = 16
   Columns("J:J").ColumnWidth = 8.5
   Range("h2").Select
  
End Sub

Danke schonmal!

boje

[Der Steuerfuzzi]

Hallo,

hat sich evtl. der Link geändert? Geht es, wenn Du den Link in einen Browser kopierst?

[snickers]

For k = 7 To j
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Inc. Common Stoc", "")
'[... usw.]
Cells(k, "C").Value = Replace(Cells(k, "C").Value, ", Incorporated", "")
Next

wäre sicherlich schneller, wenn Du verwendest:

For k = 7 To j
q = Cells(k, "C")
q = Replace(q, ", Inc. Common Stoc", "")
'[... usw.]
q = Replace(q, ", Incorporated", "")
Cells(k, "C") = q
Next

Ob Du die äußere Schleife - genauso in Variantarrays schreibend - ebenfalls signifikant beschleunigen kannst, kann ich nicht messen.

[RPP63]

Moin!
Zunächst gehe ich ebenfalls von einem toten Link aus.
@snickers:
Ich würde hier statt der Replace-Funktion die Range.Replace-Methode nehmen.
Erspart die äußere Schleife mit den einzelnen Zellzugriffen.
Ungetestet:

With Range("C7:C" & j)
   .Replace ", Inc. Common Stoc", "", xlPart
   .Replace ", Incorporated", "", xlPart
   […]
End With

Gruß Ralf