code execution has been interrupted hatası

D

dragon44760

Katılım
30 Mart 2008
Mesajlar
280
Excel Vers. ve Dili
Microsoft Office Excel 2003, Türkçe
Excel 2003 ve XP işletim sisteminde çalışan kod excel 2010 ve windows 8.1 de "code execution has been interrupted" hatası veriyor.

Aşağıdaki kodla web sayfasında kişi kodunu girerek kişi bilgilerini sorgulamakta ve yeni yolluk bildirimi girişine başlamaktadır. Excelde dolu satırdaki verileri satır satır kaydetmekte ve boş satıra geçince yolluk bildirimini listeleyerek PDF'yi bilgisayara kaydetmektedir. Benim sorunum webe ilk dolu satırı kaydetmekte, 8 saniye beklemekte ve bir alt satıra geçmektedir. Ancak her ne hikmetse alt satırı seçen kodda hata vermektedir. Bu hatanın sebebi ne olabilir? Yardımcı olursanız sevinirim.

* Hata veren bölüm kırmızı ile işaretlendi.

Kod: 
Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" _
            (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Global Const SW_MAXIMIZE = 3
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Dim SWs As New SHDocVw.ShellWindows
Dim IE As SHDocVw.InternetExplorer
Sub Yolluk_()
     For Each IE In SWs
     If Left(IE.LocationURL, 4) = "http" Then
     Set HTML_Body = IE.document.getElementsByTagName("Body").Item(0)
     If Cells(62, 29) = 0 Then Exit Sub
     Sat_1 = ActiveCell.Row
     If Cells(ActiveCell.Row, 2) = "" And Sat_1 = 31 Then Exit Sub
     If Cells(ActiveCell.Row, 2) = "" Then
     If Sheets("Liste").Range("D1").Value <> "KAYDET" Then Exit Sub
     'MsgBox "Giriş İşlemleri Bitti.!", vbOKOnly + vbInformation, "BİTTİ..!"
     HTML_Body.all.scmEksgun.Focus
     Application.SendKeys "{TAB 3}", True
     'Application.SendKeys "{TAB}", True
     'Application.SendKeys "{TAB}", True
     HTML_Body.all.tusListe.Focus
     SendKeys "{ENTER}", True
     
     Application.Wait Now + TimeValue("00:00:07")
     Application.SendKeys "{LEFT}", True
     Application.Wait Now + TimeValue("00:00:01")
     SendKeys "{ENTER}", True
     Application.Wait Now + TimeValue("00:00:07")
     SendKeys ActiveSheet.Cells(29, 1) & ActiveSheet.Cells(29, 2)
     SendKeys "{ENTER}", True
     Application.SendKeys "{ESC}", True
     SendKeys "{ESC}", True
     Exit Sub
     End If
     On Error GoTo ErrHandler:
     apiShowWindow IE.hwnd, SW_SHOWNORMAL
     apiShowWindow IE.hwnd, SW_MAXIMIZE
     sat = ActiveCell.Row
     Sut = ActiveCell.Column
     If sat = 31 And Sut = 2 Then
 
    
     Set objCollection = IE.document.getElementsByTagName("input")
     i = 0
     Do While i < objCollection.Length
     If objCollection(i).Name = "tustemizle" And objCollection(i).Type = "submit" Then
     'İnternet sayfasında “sorgula” butonuna tıklanıyor.
     objCollection(i).Click
     'Döngüden çıkılıyor.
     Exit Do
     End If
     i = i + 1
     Loop
     
     Do Until IE.readyState = 4: DoEvents: Loop
     Do While IE.Busy: DoEvents: Loop
     
     Set HTML_Body = IE.document.getElementsByTagName("Body").Item(0)
     Set HTML_Tables = HTML_Body.getElementsByTagName("Table")
     Set MyTable = HTML_Tables(1)
     Set HTML_bottom = HTML_Body.getElementsByTagName("bottom")
     HTML_Body.all.etkPbik.Value = ActiveSheet.Cells(1, 10).Value
     HTML_Body.all.etkPbik.Focus
     SendKeys "{TAB}", True
    
     Application.Wait Now + TimeValue("00:00:08")
     
     If Sheets("Liste").Range("E1").Value = "SİSTEM" Then
     EK_GÖSTERGE = HTML_Body.all.etkEkgst.Value
     Else
     EK_GÖSTERGE = Cells(1, 11).Value
     End If
     
     If EK_GÖSTERGE > 2999 Then
     HTML_Body.all.scmGndmkt.Value = "37,50"
     Else
     HTML_Body.all.etkEkgst.Focus
     End If
     HTML_Body.all.scmBsltrh_scmGun.Value = ActiveSheet.Cells(ActiveCell.Row, 13).Value
     HTML_Body.all.scmBsltrh_scmAy.Value = ActiveSheet.Cells(ActiveCell.Row, 14).Value
     HTML_Body.all.scmBsltrh_scmYil.Value = ActiveSheet.Cells(ActiveCell.Row, 15).Value
     HTML_Body.all.scmBtmTrh_scmGun.Value = ActiveSheet.Cells(ActiveCell.Row, 17).Value
     HTML_Body.all.scmBtmTrh_scmAy.Value = ActiveSheet.Cells(ActiveCell.Row, 18).Value
     HTML_Body.all.scmBtmTrh_scmYil.Value = ActiveSheet.Cells(ActiveCell.Row, 19).Value
     HTML_Body.all.etkYol.Value = "SAMSUN" + "-" + ActiveSheet.Cells(ActiveCell.Row, 2).Value + "-" + "SAMSUN"
     If Cells(ActiveCell.Row, 7) = "RESMİ" Then
     HTML_Body.all.scmYolcst.Value = "8"
     Else
     HTML_Body.all.scmYolcst.Value = "1"
     End If
     HTML_Body.all.etkBslsaa.Value = ActiveSheet.Cells(ActiveCell.Row, 16).Value
     HTML_Body.all.etkBtmsaa.Value = ActiveSheet.Cells(ActiveCell.Row, 20).Value
     HTML_Body.all.etkGunsys.Value = ActiveSheet.Cells(ActiveCell.Row, 30).Value
     HTML_Body.all.scmEksgun.Value = ActiveSheet.Cells(ActiveCell.Row, 29).Value
     HTML_Body.all.scmEksgun.Focus
     Application.SendKeys "{TAB}", True
     Application.Wait Now + TimeValue("00:00:01")
     SendKeys "{ENTER}", True
     Application.SendKeys "{ENTER}", True
     Application.Wait Now + TimeValue("00:00:08")
     Application.SendKeys "{ESC}", True
     SendKeys "{ESC}", True
     
     Else
     Set HTML_Body = IE.document.getElementsByTagName("Body").Item(0)
     Set HTML_Tables = HTML_Body.getElementsByTagName("Table")
     Set MyTable = HTML_Tables(1)
     Set HTML_bottom = HTML_Body.getElementsByTagName("bottom")
     On Error GoTo ErrHandler:
     HTML_Body.all.scmBsltrh_scmGun.Value = ActiveSheet.Cells(ActiveCell.Row, 13).Value
     HTML_Body.all.scmBsltrh_scmAy.Value = ActiveSheet.Cells(ActiveCell.Row, 14).Value
     HTML_Body.all.scmBsltrh_scmYil.Value = ActiveSheet.Cells(ActiveCell.Row, 15).Value
     HTML_Body.all.scmBtmTrh_scmGun.Value = ActiveSheet.Cells(ActiveCell.Row, 17).Value
     HTML_Body.all.scmBtmTrh_scmAy.Value = ActiveSheet.Cells(ActiveCell.Row, 18).Value
     HTML_Body.all.scmBtmTrh_scmYil.Value = ActiveSheet.Cells(ActiveCell.Row, 19).Value
     HTML_Body.all.etkYol.Value = "SAMSUN" + "-" + ActiveSheet.Cells(ActiveCell.Row, 2).Value + "-" + "SAMSUN"
     If Cells(ActiveCell.Row, 7) = "RESMİ" Then
     HTML_Body.all.scmYolcst.Value = "8"
     Else
     HTML_Body.all.scmYolcst.Value = "1"
     End If
     HTML_Body.all.etkBslsaa.Value = ActiveSheet.Cells(ActiveCell.Row, 16).Value
     HTML_Body.all.etkBtmsaa.Value = ActiveSheet.Cells(ActiveCell.Row, 20).Value
     HTML_Body.all.etkGunsys.Value = ActiveSheet.Cells(ActiveCell.Row, 30).Value
     HTML_Body.all.scmEksgun.Value = ActiveSheet.Cells(ActiveCell.Row, 29).Value
     HTML_Body.all.scmEksgun.Focus
     Application.SendKeys "{TAB}", True
     Application.Wait Now + TimeValue("00:00:01")
     SendKeys "{ENTER}", True
     Application.SendKeys "{ENTER}", True
     Application.Wait Now + TimeValue("00:00:08")
     Application.SendKeys "{ESC}", True
     SendKeys "{ESC}", True
     
     End If
     End If
     Next
     Application.Wait Now + TimeValue("00:00:08")
     [COLOR="Red"]ActiveCell.Offset(1, 0).Select[/COLOR]
     Run "Yolluk_"
     GoTo SafeExit:
ErrHandler:
     MsgBox "Bağlantı hızınız yetersiz veya siteye zaten login durumdasınız." _
     & vbCrLf & "Başka bir neden de;" & vbCrLf & Err.Description, vbCritical, "Dikkat...!"
     IE.Visible = True
SafeExit:
     Set HTML_Body = Nothing
     Set HTML_Tables = Nothing
     Set MyTable = Nothing
     Set IE = Nothing
End Sub
 
Zeki Gürsoy

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,383
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Bu hata, bilgisayar yeniden başlatıldığında düzelir. Bilgisayar yeniden başlatıldıktan sonra kod çalıştırıldığında sorun devam ediyorsa, prosedur bloğu baştan sona gözden geçirilmelidir. Çünkü buna neden olan satır prosedurun içindedir.
 
D

dragon44760

Katılım
30 Mart 2008
Mesajlar
280
Excel Vers. ve Dili
Microsoft Office Excel 2003, Türkçe
Sn. Zeki Gürsoy yardımınız için teşekkürler. Prosedur bloğunu kontrol ettiğimde hatayı gördüm ve düzelttim.

Konuyla ilgili sormak isteğim farklı bir soru var. XP'de webde listeleme yaptığımızda Aç, Kaydet ve İptal diyalog penceresi aktif olduğundan
Kod: 
Application.SendKeys "{LEFT}", True
ile kaydet butonuna gelip
Kod: 
Application.SendKeys "{ENTER}", True
tuşu göndererek en son kaydettiğimiz klasöre kayıt işlemini gerçekleştiriyordum. Windows 8.1 ile kullanılan explorer 11'de kod ile kaydet butonuna nasıl çalıştırabilirim (bastırabilirim)?
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst