su Excel 2007 mi riporta errore di run-time -2147467259 (80004005)
questo il codice della macro che viene richiamata e dove da l'errore
- Codice: Seleziona tutto
Sub A2_Estrai_valori()
Dim myURL As String
myURL = Range("B1").Value
namefg = Range("A1").Value
Set IE = CreateObject("InternetExplorer.Application") ' ---> si BLOCCA QUI
With IE
.Navigate myURL
.Visible = False
Do While .Busy: DoEvents: Loop 'Attesa not busy
Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
End With
Range("D:G").Clear ' cancella la sezione di acquisizione dei nuovi dati
Range("D:D").NumberFormat = "dd/mm/yyyy hh\:mm\:ss"
Range("B4").NumberFormat = "dd/mm/yyyy hh\:mm\:ss"
MyDoc = IE.Document.body.innertext
man = "non è consentito" '<<< La stringa da controllare"
man1 = "non si sono" '<<< La stringa da controllare"
manExist = Len(MyDoc) = (Len(man) + Len(Replace(MyDoc, man, "")))
man1Exist = Len(MyDoc) = (Len(man1) + Len(Replace(MyDoc, man1, "")))
If manExist Then
Range("A2") = "MANUALE"
Else
Range("A2") = "AUTOMATICO"
End If
If man1Exist Then Range("A4") = "New"
Set TagColl = IE.Document.getElementsByTagName("TD")
For Each myTag In TagColl
If myTag.className = "items_list_timebid" Then
Range("B2") = Left(myTag.innertext, (InStr(myTag.innertext, ":") + 5))
End If
If myTag.className = "items_list_price" Then
Range("B3") = myTag.innertext
End If
If Left(myTag.ID, 19) = "last_bids_datetime_" Or MyFound Then
If Len(myTag.innertext) > 1 Then
If j = 0 Then
Range("D1").Offset(i, j) = CDate(myTag.innertext)
Else
Range("D1").Offset(i, j) = myTag.innertext
End If
End If
MyFound = True
j = (j + 1) Mod 4
i = i - 1 * (j = 0)
If i > 9 Then Exit For ' Per uscire dal ciclo dopo aver acquisito i 10 dati
End If
Next myTag
' per inserire i dati persi
If Range("F10").Value <> "" Then
For a = 0 To (Range("F10").Value - Range("M1").Value) * 100 - 1
If Range("M1").Value > 0.01 Then
If Range("G10").Value = "Automatica" And x = 0 Then
Range("D10:G10").Select ' se quello che rilancia è in automatico allora prendi l'ultimo altrimenti duplica con offerente vecchio
x = 1
Else
Range("K2:N2").Select
End If
Selection.Copy
Range("K1:N1").Select
Selection.Insert Shift:=xlDown
Range("M1").Value = Range("M2").Value + 0.01
Selection.Font.ColorIndex = 3
End If
Next a
End If
For a = 10 To 1 Step -1
If Range("D1").Offset(a - 1, 2).Value <> " " And Range("D1").Offset(a - 1, 2).Value > Range("M1").Value Then
Range("D" & a & ":G" & a).Select 'brutto codice a vedersi
Selection.Copy
Range("K1:N1").Select
Selection.Insert Shift:=xlDown
End If
Next a
Columns("A:Z").EntireColumn.AutoFit
Call A3_ChiQt
MyDoc = IE.Document.body.innertext
chs = "chiusa." '<<< La stringa da controllare" ' ******** controlla sopra visto che se prima è negativo è chiusa
chsExist = Len(MyDoc) = (Len(chs) + Len(Replace(MyDoc, chs, "")))
If chsExist Then
For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
Cells(i, 15).Value = myURL
Next i
Worksheets("Raccolta").Range("CA:CE").Value = ActiveSheet.Range("K:O").Value
Call A4_Vittorie
Application.DisplayAlerts = False ' per evitare che si fermi per conferma nella cancellazione del foglio
ActiveSheet.Delete
Application.DisplayAlerts = True
nfg = nfg - 1
End If
IE.Quit
Set IE = Nothing
End Sub
Sai suggerirmi eventuali sistemi per gestire l'errore e fare ripartire la macro o ciclo in automatico da solo ?