Başka bilgisayarda hata

[Kusta]

Merhabalar,
Yaptığım makrolar çok güzel bir şekilde çalışıyor. Fakat bazı bilgisayarlarda "object variable or With block variable not set" hatası alıyoruz. Excelde makro güvenliğinden erişime güveni de yapmamıza rağmen çalıştıramıyoruz.
Neden olur bu. yardımcı olabilir misiniz?

 

[Kusta]

Adım adım gittiğimde çalışıyor makro. ama direk makroyu başlattığımda hata veriyor

 

[Kusta]

kod aşağıdaki gibidir.

Sub ekap()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
Application.Wait Now + TimeValue("00:00:02")
ie.Navigate "https://ekap.kik.gov.tr/EKAP/Yasaklilik/YasakliSorgu.aspx"
Application.Wait Now + TimeValue("00:00:2")
ie.Width = 1500
ie.Height = 1000
ie.Visible = False
While ie.Busy
DoEvents
Wend
son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "H") = "İŞLEM TAMAM" Then
GoTo 0
Else

ie.document.getElementById("ctl00_ContentPlaceHolder1_TextBoxTCKimlikNo").Value = Cells(i, "A")
ie.Visible = False
While ie.Busy
DoEvents
Wend

Set TrackID = ie.document.getElementById("ctl00_ContentPlaceHolder1_btnAra")
ie.document.getElementById("ctl00_ContentPlaceHolder1_btnAra").Click
ie.Visible = False
While ie.Busy
DoEvents
Wend


Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet

y = 2 'Column A in Excel
z = 1 'Row 1 in Excel
Do While ie.Busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

Set doc = ie.document
Set hTable = doc.GetElementsByTagName("table")
Set tb = hTable(1)
Set hBody = tb.GetElementsByTagName("tbody")

For Each bb In hBody
Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR
Set hTD = tr.GetElementsByTagName("td")
y = 2 ' Resets back to column A
For Each td In hTD
ws.Cells(i, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1
Next tr
Next bb
Cells(i, "H").Value = "İŞLEM TAMAM"
ie.Visible = False
While ie.Busy
DoEvents
Wend
0:
End If
Next
ie.Quit
End Sub

 

[Kusta]

Yardımcı olabilecek olan varmı.
Bazende object reguired hatası veriyor ve işlem yapmıyor. ama f8 ile ilerlediğimde sorunsuz çalışıyor. Bunun çözümü ne olabilir.

 

[halit3]

Bu şekilde denermisiniz.

Sub ekap()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "https://ekap.kik.gov.tr/EKAP/Yasaklilik/YasakliSorgu.aspx"
ie.Width = 1500
ie.Height = 1000
ie.Visible = False

Do While ie.Busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "H") = "İŞLEM TAMAM" Then GoTo atla

ie.document.getElementById("ctl00_ContentPlaceHolder1_TextBoxTCKimlikNo").Value = Cells(i, "A")
ie.document.getElementById("ctl00_ContentPlaceHolder1_btnAra").Click

Do While ie.Busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

Dim y As Long, z As Long

y = 2 'Column A in Excel
z = 1 'Row 1 in Excel

Application.Wait Now + TimeValue("00:00:01")

Set hBody = ie.document.GetElementsByTagName("table")(1).GetElementsByTagName("tbody")

For Each bb In hBody
Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR
Set hTD = tr.GetElementsByTagName("td")
y = 2 ' Resets back to column A
For Each td In hTD
Cells(i, y).Value = td.innertext
y = y + 1
Next td

z = z + 1
Next tr
Next bb
Cells(i, "H").Value = "İŞLEM TAMAM"
atla:

Next
ie.Quit
MsgBox "işlem tamam"
End Sub

 

[Kusta]

Bu şekilde denermisiniz.

Sub ekap()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "https://ekap.kik.gov.tr/EKAP/Yasaklilik/YasakliSorgu.aspx"
ie.Width = 1500
ie.Height = 1000
ie.Visible = False

Do While ie.Busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "H") = "İŞLEM TAMAM" Then GoTo atla

ie.document.getElementById("ctl00_ContentPlaceHolder1_TextBoxTCKimlikNo").Value = Cells(i, "A")
ie.document.getElementById("ctl00_ContentPlaceHolder1_btnAra").Click

Do While ie.Busy: DoEvents: Loop
Do While ie.ReadyState <> 4: DoEvents: Loop

Dim y As Long, z As Long

y = 2 'Column A in Excel
z = 1 'Row 1 in Excel

Application.Wait Now + TimeValue("00:00:01")

Set hBody = ie.document.GetElementsByTagName("table")(1).GetElementsByTagName("tbody")

For Each bb In hBody
Set hTR = bb.GetElementsByTagName("tr")
For Each tr In hTR
Set hTD = tr.GetElementsByTagName("td")
y = 2 ' Resets back to column A
For Each td In hTD
Cells(i, y).Value = td.innertext
y = y + 1
Next td

z = z + 1
Next tr
Next bb
Cells(i, "H").Value = "İŞLEM TAMAM"
atla:

Next
ie.Quit
MsgBox "işlem tamam"
End Sub

Çok teşekkür ederim. Çalıştı.

 

[halit3]

Teşekkürler iyi çalışmalar