buongiorno
dopo aggiornamento windows 11 la macro si blocca in questo punto Resume Uscita con questo errore 462 il computer server remoto
non esiste o non è disponibile
il link è questo https://www.betexplorer.com/soccer/arge ... ofesional/
Sub importa_torneo()
Application.ScreenUpdating = False
Sheets("dati").Activate
Call Importa_classifica_home
Dim mIE As Object
Dim mTables, mTable
Dim mRows, mRow
Dim mCells, mCell
Dim mRiga As Long, mColonna As Long
Dim k As Integer, k1 As Integer, n As String, f As Integer
Dim flag1 As Boolean
On Error GoTo errori
If Range("ao1") = "" Then
MsgBox "Inserire in l1 il numero della tabella da stampare"
Exit Sub
End If
n = Range("ao1")
Range("ap2:ay800").ClearContents
mRiga = 2
k = 0
f = 0
k1 = 0
Set mIE = CreateObject("InternetExplorer.Application")
With mIE
.AddressBar = False
.StatusBar = False
.MenuBar = False
.Toolbar = 0
.Visible = False ' True= fa vedere la pagina web
.navigate Range("ap1").Value '"http://data2.7m.cn/team_data/212/en/index.shtml"
End With
'Attesa finchè la pagina non è completamente caricata
While mIE.Busy
Wend
While mIE.document.readyState <> "complete"
Wend
Set mTables = mIE.document.all.tags("TABLE")
With mTables
' If .WebTables = (0) Then 'CStr(Range("l1").Value) Then
For Each mTable In mTables
k1 = k1 + 1
If k1 = n Then
f = f + 1
Set mRows = mTable.Rows
For Each mRow In mRows
Set mCells = mRow.Cells
If Cells(mRiga - 1, 1) = "" Or Cells(mRiga - 1, 1) = "No." Then
mColonna = 41
Else
mColonna = 41
End If
If k = 1 Then mColonna = 41
For Each mCell In mCells
ActiveSheet.Cells(mRiga, mColonna) = mCell.innerText
mColonna = mColonna + 1
Next mCell
mRiga = mRiga + 1
Next mRow
k = 1
If f = 1 Then
Range("j1:j" & mRiga - 1).Select
Selection.Style = "Comma"
k1 = k1 - 1
End If
End If
Next mTable
' End If
End With
Uscita:
Set mCell = Nothing
Set mCells = Nothing
Set mRow = Nothing
Set mRows = Nothing
Set mTable = Nothing
Set mTables = Nothing
mIE.Quit
Set mIE = Nothing
Exit Sub
errori:
MsgBox Err.Number & "-" & Err.Description
Resume Uscita
End Sub
Registrazione
