Зависание скрипта на vba

[grec111]

Написал маленький скрипт. ходит по сайтам и смотрит если ли на странице нужный ресурс, в общем ниче особенного. Но при запуске скрипта excel не то чтобы зависает просто не разрешает переключение на другие документы excel,вроде все забирает главный цикл.
Вот пример кода


While Cells(i, 1) <> ""
If Left(Cells(i, 1), 7) <> "http://" And Left(Cells(i, 1), 8) <> "https://" Then
Cells(i, 1) = "http://" + Cells(i, 1)
End If
i = i + 1
Wend
i = 0

If Cells(2, 1) = "" Or Cells(2, 2) = "" Then
prov_server_er = 1
GoTo end_pr
End If
z = 0
prov_server_er = 0
nof_i = 0
Dim povt As Double
povt = 0
y = 2
While Cells(y, 2) <> ""
anc(y - 1) = Cells(y, 2)
y = y + 1
Wend
cou_anc = y - 2
Dim res As Integer
Dim ht As String
res = 0
i = 2
While Cells(i, 1) <> ""
url = Cells(i, 1)
Dim PostData As Byte
WebBrowser1.Navigate url

dol_otkr = 0
WebBrowser1.Silent = True
Do Until WebBrowser1.ReadyState = READYSTATE_COMPLETE
If dol_otkr = 3500000 Then
GoTo dolgoe_otkrutie
End If
dol_otkr = dol_otkr + 1
DoEvents
Loop
ht = WebBrowser1.Document.Body.innerhtml

ну и далее еще капашусь в коде. можно как то оптимизировать или переделать чтобы можно было одновременно работать во многих документах?

[EducatedFool]

можно как то оптимизировать или переделать чтобы можно было одновременно работать во многих документах?

Натолкать несколько операторов DoEvents - и подвисать Excel не будет:

Dim IE As InternetExplorer 
Set IE = New InternetExplorer 
' Открываем нужную ссылку и ждем, пока она прогрузится 
IE.Navigate "http://адрес_ссылки" 
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE 
   DoEvents 
Wend 
' Заполняем нужные поля для входа 
IE.Document.Forms.loginForm.elements("login[name]").Value = "Логин" 
IE.Document.Forms.loginForm.elements("login[pass]").Value = "Пароль" 
IE.Document.Forms(0).Submit 
' Опять ждем конца обработки 
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE 
   DoEvents 
Wend 
' Переходим на страничку с нужными данными 
IE.Navigate "http://адрес_ссылки" 
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE 
   DoEvents 
Wend 
' Читаем данные нужной таблицы 
With IE.Document.all.tags("table").Item(0) 
   For I = 0 To .all.tags("tr").Length - 1 
      For J = 0 To .all.tags("tr").Item(I).all.tags("td").Length - 1 
         Cells(I,J) = .all.tags("tr").Item(I).all.tags("td").Item(J).InnerText 
      Next J 
   Next I 
End With 
IE.Close  
Set IE = Nothing

Sub test()
Set IE = CreateObject("InternetExplorer.Application"): DoEvents

IE.Navigate "http://ExcelVBA.ru"
While IE.readyState <> 4: DoEvents: Wend ' ждем, пока загрузится страница
Set ieDoc = IE.Document

For i = 0 To IE.Document.all.Length - 1
MsgBox IE.Document.all.item(i).innerText, vbInformation, "Элемент № " & i
Next

IE.Quit
Set IE = Nothing
End Sub

Можно и код подправить - но без вашего файла это сложно сделать.