Makro İle Otomatik Döngüyu nasıl Sağlarım

[Grimm80]

Selamı Aleyküm

A sutunumda linkler var fakat bazı satırlarda link adresi yok yani boş

aşağıdaki gibi kodum var fakat web kısmına ben açılması istediğim linkleri elimde girmek zorundayım Yapmak istediğim A sutunda link var ise otomatik döngüye girmesini istiyorum. Boş olan satırları es geçip ve link olan sayfayı açıp 15 saniye gösterip sonra o sayfayı kapatıp çıkış yapıp yeni sayfayı açmasını istiyorum.Aşağıdaki kodu döngüye nasıl sokabilirim.

Tşk.ler



Sub webac()
web = Array("http://www.google.com", "http://www.n11.com", "http://www.gittigidiyor.com", "http://www.ebay.com", "http://www.edi.com")
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
For a = 0 To UBound(web)
With IE
.Navigate web(a)
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
End With

Set doc = IE.document

If a < UBound(web) Then Application.Wait Now + TimeValue("00:00:15")
Next
Set doc = Nothing
IE.Quit
Set IE = Nothing

End Sub

 

[isteobenim]

Merhaba,

Aşağıdaki kodları ilave ederek bir deneyin isterseniz,

Dim web As String
web = Sheets("Sayfa1").Range("A1").Value

 

[Grimm80]

Tşk. ederim fakat olmadı

 

[askm]

Kodlarınız çalışıyor. Yalnız sayfalar tam yüklendikten sonra 15 sn bekliyor. O yuzden süre biraz uzun gibi görülebilir. Eğer sayfalar arasında ie yi tamamen kapatsın istiyorsanız
Set doc = Nothing
IE.Quit

kısmını next kısmından önce almanız gerekir. Yalnız burda doc. kısmını herhangi bir veri çekme vb. işlem yapmıyorsanız gerek yok. Şimdilik gereksiz bir kod gibi gözüküyor.

 

[PLİNT]

Selamı Aleyküm
Yapmak istediğim A sutunda link var ise otomatik döngüye girmesini istiyorum..

Merhaba
Aşağıdaki gibi olabilir.
"A" sütununda adreslerde köprü yoksa kırmızı bölümü

If Cells(a, 1)<>""  Then

şeklinde değiştirirsiniz.
http://s9.dosya.tc/server2/ii10b7/deneme.zip.html

[SIZE="2"]Sub webac()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
i = Cells(Rows.Count, "A").End(3).Row
For a = 1 To i + 1
If a = i + 1 Then GoTo 10
[COLOR="Red"]If Cells(a, 1).Hyperlinks.Count = 1 Then[/COLOR]
With IE
.Navigate Cells(a, 1).Value
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
End With
Set doc = IE.document
 If i > a Then Application.Wait Now + TimeValue("00:00:15")
End If
Next
10:
 Set doc = Nothing
IE.Quit
Set IE = Nothing
End Sub
 [/SIZE]

 

[Grimm80]

Çok Teşekkür ederim ilginizden dolayı