• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Webden veri çekmede hata

  • Konbuyu başlatan Konbuyu başlatan Kusta
  • Başlangıç tarihi Başlangıç tarihi
Katılım
30 Kasım 2018
Mesajlar
94
Excel Vers. ve Dili
2016
Arkadaşlar kolay gelsin.
Excele webden veri çekiyorum, sistem şöyleki
"A2" sütunundaki TC ile portal üzerinden sorgulama yapıyor ve sorgulama sonucu webde yer alan tablo verilerini, excelin sırasıyla "B2, C2, D2 VE E2" sütunlarına yazıyor.
Sonra "A3" sütunudaki TC ile portal üzerinden sorgulama yapıyor ancak çıkan yeni tablo verilerini "B3, C3, D3 VE E3" sütunlarına yazması gerekirken yine "B2, C2, D2 VE E2" sütunlarının üstüne yazıyor.
İstediğim; sorgulanan TC kimlik numarasının yazılı olduğu sütunun karşısına gelen sütunlara verileri yazması.
Formül aşağıdaki gibidir yardımcı olabilirseniz sevinirim.
Site ismi veremiyorum giremezsiniz çünkü. Server üzerinden bağlanıyoruz.

Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://portalint...............aspx"
IE.Width = 1500
IE.Height = 1000
IE.Visible = True
While IE.Busy
DoEvents
Wend
son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "A") = "" Then
Cells(i, "B") = "TC Gir!!!"
Else
IE.document.getElementById("ctlTcKimlikNo").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents
Wend

Set TrackID = IE.document.getElementById("Command..............._CommandItem_.........................Sorgula")
IE.document.getElementById("Command..............._CommandItem_.........................Sorgula").Click
IE.Visible = True
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 = 1 '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(2)
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")
Set td = hTable
y = 2 ' Resets back to column B
For Each td In hTD
ws.Cells(z, y).Value = td.innertext
y = y + 1
Next td
DoEvents
z = z + 1
Next tr
Next bb


IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit
End Sub
 
Rich (BB code):
ws.Cells(z, y).Value = td.innertext
yukarıdaki bölümü aşağıdaki ile değiştir.
Rich (BB code):
ws.Cells(i, y).Value = td.innertext
 
Rich (BB code):
ws.Cells(z, y).Value = td.innertext
yukarıdaki bölümü aşağıdaki ile değiştir.
Rich (BB code):
ws.Cells(i, y).Value = td.innertext
Çok teşekkür ederim eline sağlık.
Bir sorum daha olacak bu tablodan 4 veri alıyorum. Sadece 1 tanesini almak istesem yapabilirmiyim.
Şöyle diyelim webdeki veriyi excelde "B2, C2, D2 VE E2" sütunlarına yazıyor, ben sadece webdeki tablodan bu dört veriyi değilde 2. sırada yer alanı alıp "B2" ye yazmasını istesem nasıl bir yol izlemeliyim.
 
KOD
Rich (BB code):
Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://portalint...............aspx"
IE.Width = 1500
IE.Height = 1000
IE.Visible = True
While IE.Busy
DoEvents
Wend
son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "A") = "" Then
Cells(i, "B") = "TC Gir!!!"
Else
IE.document.getElementById("ctlTcKimlikNo").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents
Wend

Set TrackID = IE.document.getElementById("Command..............._CommandItem_.........................Sorgula")
IE.document.getElementById("Command..............._CommandItem_.........................Sorgula").Click
IE.Visible = True
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 = 1 'Column A 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(2)
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")
Set td = hTable
y = 2 ' Resets back to column B
For Each td In hTD
If y = 3 Then
ws.Cells(i, "b").Value = td.innertext
End If
y = y + 1
Next td
DoEvents

Next tr
Next bb

IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit
End Sub
 
KOD
Rich (BB code):
Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://portalint...............aspx"
IE.Width = 1500
IE.Height = 1000
IE.Visible = True
While IE.Busy
DoEvents
Wend
son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "A") = "" Then
Cells(i, "B") = "TC Gir!!!"
Else
IE.document.getElementById("ctlTcKimlikNo").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents
Wend

Set TrackID = IE.document.getElementById("Command..............._CommandItem_.........................Sorgula")
IE.document.getElementById("Command..............._CommandItem_.........................Sorgula").Click
IE.Visible = True
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 = 1 'Column A 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(2)
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")
Set td = hTable
y = 2 ' Resets back to column B
For Each td In hTD
If y = 3 Then
ws.Cells(i, "b").Value = td.innertext
End If
y = y + 1
Next td
DoEvents

Next tr
Next bb

IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit
End Sub
Ellerine sağlık. Süpersin.
Çok teşekkür ederim.
 
Teşekkürler iyi çalışmalar
 
Teşekkürler iyi çalışmalar
Kolay gelsin rahatsız ediyorum ama yardımcı olabilirsen sevinirim.

Aşağıdaki kodla bizim portala bağlanıyorum. Sonra bir yerde seç işlemine tıklıyorum ve sayfanın içinde küçük yeni bir sayfa açıyor. Oraya işyerinin numarsını girip seçtikten sonra o sayfayı kapatıyor ve tekrar eski sayfaya dönerek işyerinin gösteriyor. Ancak kırmızı ile belirttiğim yerde yani küçük sayfa açıldıktan sonraki yere ben "A" sütunundaki işyeri numarasını yaz komutu verdiğim halde işlemi gerçekleştirmiyor ve hata alıyorum. kaç gündür uğraşıyorum fakat çözemedim.
Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://portalint..........................rupYonetimi.aspx"
IE.Width = 1500
IE.Height = 1000
IE.Visible = True
While IE.Busy
DoEvents
Wend

son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "A") = "" Then
Cells(i, "D") = "İşyeri numarası gir!!!"
Else
Set TrackID = IE.document.getElementById("ctl02_ctlIsverenSec_link")
IE.document.getElementById("ctl02_ctlIsverenSec_link").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend
IE.document.getElementById("ctl02_ctlCriteriaControl_NO").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents

Wend
Set TrackID = IE.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search")
IE.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend
Set TrackID = IE.document.getElementById("ctl02_ctlDataGrid_ctl02_ctlSelect")
IE.document.getElementById("ctl02_ctlDataGrid_ctl02_ctlSelect").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend

IE.document.getElementById("ctl02_ctlGrupIsyeriTransfer").Value = "1"
IE.Visible = True
While IE.Busy
DoEvents
Wend

Set TrackID = IE.document.getElementById("ctl02_ctlIsyeriCommand_CommandItem_Grupatama")
IE.document.getElementById("ctl02_ctlIsyeriCommand_CommandItem_Grupatama").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend

IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit
End Sub
 
Teşekkürler iyi çalışmalar
Kolay gelsin rahatsız ediyorum ama yardımcı olabilirsen sevinirim.

Aşağıdaki kodla bizim portala bağlanıyorum. Sonra bir yerde seç işlemine tıklıyorum ve sayfanın içinde küçük yeni bir sayfa açıyor. Oraya işyerinin numarsını girip seçtikten sonra o sayfayı kapatıyor ve tekrar eski sayfaya dönerek işyerinin gösteriyor. Ancak kırmızı ile belirttiğim yerde yani küçük sayfa açıldıktan sonraki yere ben "A" sütunundaki işyeri numarasını yaz komutu verdiğim halde işlemi gerçekleştirmiyor ve hata alıyorum. kaç gündür uğraşıyorum fakat çözemedim.
Sub Arama()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate "http://portalint..........................rupYonetimi.aspx"
IE.Width = 1500
IE.Height = 1000
IE.Visible = True
While IE.Busy
DoEvents
Wend

son = Cells(Rows.Count, "A").End(3).Row
For i = 2 To son
If Cells(i, "A") = "" Then
Cells(i, "D") = "İşyeri numarası gir!!!"
Else
Set TrackID = IE.document.getElementById("ctl02_ctlIsverenSec_link")
IE.document.getElementById("ctl02_ctlIsverenSec_link").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend
IE.document.getElementById("ctl02_ctlCriteriaControl_NO").Value = Cells(i, "A")
IE.Visible = True
While IE.Busy
DoEvents

Wend
Set TrackID = IE.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search")
IE.document.getElementById("ctl02_ctlPageCommand_CommandItem_Search").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend
Set TrackID = IE.document.getElementById("ctl02_ctlDataGrid_ctl02_ctlSelect")
IE.document.getElementById("ctl02_ctlDataGrid_ctl02_ctlSelect").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend

IE.document.getElementById("ctl02_ctlGrupIsyeriTransfer").Value = "1"
IE.Visible = True
While IE.Busy
DoEvents
Wend

Set TrackID = IE.document.getElementById("ctl02_ctlIsyeriCommand_CommandItem_Grupatama")
IE.document.getElementById("ctl02_ctlIsyeriCommand_CommandItem_Grupatama").Click
IE.Visible = True
While IE.Busy
DoEvents
Wend

IE.Visible = True
While IE.Busy
DoEvents
Wend
End If
Next
IE.Quit
End Sub
 
web sitesi belli olmayan kodlara nasıl müdehale edeceğiz
bu şekilde cevap yazmam ve yardımcı olmamın imkanı yok.
 
Geri
Üst