mustafa1205
Altın Üye
- Katılım
- 23 Ekim 2010
- Mesajlar
- 1,437
- Excel Vers. ve Dili
- Office 2016 / 64 Bit - Türkçe
Kusura bakmayın anlamadım da. Malesef siteden veri almayı bilmiyorum hiç denemedim.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Listele()
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.resmigazete.gov.tr/default.aspx"
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
.Document.all("ImageButton_arsiv").Click
On Error Resume Next
[COLOR=DarkGreen] 'JavaScript beklemediği için, aşağıdaki gibi kontrol etmek gerek.
'Aslında sayfanın hiç açılamaması olasılığı için bir de zaman aşımı
'kontrolu gerekir. Aksi halde sonsuz döngü içinde kalabilir...[/COLOR]
Do
DoEvents
Err.Clear
.Document.getelementbyid("arsiv_LinkButtonMenuFihrist").Click
Loop Until Err.Number = 0
[COLOR=DarkGreen] '************** veya ************************
'Application.Wait Now + TimeValue("00:00:01")
'.Document.parentWindow.execScript "__doPostBack('arsiv$LinkButtonMenuFihrist','')", "JavaScript"
'********************************************[/COLOR]
Do
DoEvents
Err.Clear
.Document.all("arsiv_DropDownListArsivFihrist_Mevzuat_Turu").Value = "Tamamı" [COLOR=DarkGreen]'combo[/COLOR]
.Document.all("arsiv_DropDownListArsivFihristGun1").Value = [o2] [COLOR=DarkGreen]'gün[/COLOR]
.Document.all("arsiv_DropDownListArsivFihristAy1").Value = [p2] [COLOR=DarkGreen]'ay[/COLOR]
.Document.all("arsiv$DropDownListArsivFihristYil1").Value = [q2] [COLOR=DarkGreen]'yıl[/COLOR]
.Document.all("arsiv_DropDownListArsivFihristGun2").Value = [o3] [COLOR=DarkGreen]'gün[/COLOR]
.Document.all("arsiv_DropDownListArsivFihristAy2").Value = [p3] [COLOR=DarkGreen]'ay[/COLOR]
.Document.all("arsiv$DropDownListArsivFihristYil2").Value = [q3] [COLOR=DarkGreen]'yıl[/COLOR]
Loop Until Err.Number = 0
.Document.all("arsiv$ButtonArsivFihrist").Click
Application.Wait Now + TimeValue("00:00:03")
Set t = .Document.getelementbyid("arsiv_GridViewArsivFihrist")
s = 1
Do
DoEvents
s = s + 1
Set t = .Document.getelementbyid("arsiv_GridViewArsivFihrist")
If t Is Nothing Then Exit Do
For i = 0 To t.Rows.Length - 1
For j = 0 To t.Rows(i).Cells.Length - 1
Sheets("LİSTE").Cells(i + 1 + son, j + 1) = t.Rows(i).Cells(j).innertext
Next
Next
son = [a65536].End(3).Row
.Document.parentWindow.execScript "__doPostBack('arsiv$GridViewArsivFihrist','Page$" & s & "')", "JavaScript"
Application.Wait Now + TimeValue("00:00:03")
Loop
End With
MsgBox "bİTTİ", vbInformation
End Sub