• DİKKAT

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

resmi gazete

Kusura bakmayın anlamadım da. Malesef siteden veri almayı bilmiyorum hiç denemedim.
 
Rica ederim. Siz problemi çözebildiniz mi yani süzme işlemini ?
 
Konu, web sayfasından veri alma ile ilgili idi...

Sayfa javascript ile işlem yaptığından uygun zamanlamayı kontrol etmek epeyce zor oldu.
Bir örnek hazırladım ancak sayfaya geldikten sonra küçük bir düzenleme yapmanız gerekecek.

Kod:
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
 

Ekli dosyalar

Bu mudur ? Evet budur. Zeki Hocam kusura bakmayın biz bilmeden birşeyler yapalım dedik malesef olmadı. Gerçi bana da lazım olan bir çalışmaydı. Çok sağolun...
 
Ziyanı yok; soru yanlış anlaşıldı galiba. :hey:
 
Teşekkür ederim Zeki Üstadım
Çok büyük bir işten kurtardınız beni.
Yalnız bir konu daha var.Bu indirdiğimiz sadece fihrist.
Buradan resmi gazeteleri de almamız mümkün mü?
Yani her gün çıkan resmi gazeteyi dosya olarak indirebilirmiyiz?
 
Son düzenleme:
Geri
Üst