Makro ile Toplu Link Açma

[gjorfindel]

Merhabalar,

A sütununda "http://www.excel.web.tr/" gibi veriler var alt alt'a farklı linkler olduğunu düşüne bilirsiniz. Bu linkleri tek tek açmak oldukça zahmetli çünkü yaklaşık 300 link yazılı. Ben bu linkleri Makro ile ayrı sekmelerde açabiliyordum. yine bu sitede bir arkadaş yazmıştı ama konuyu bulamadığım için tekrar yapamadım.

Yardımcı olabilir misiniz?
Teşekkürler.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Ac()
    
    Dim IE As Object, i As Long

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Set IE = CreateObject("InternetExplorer.Application")
        With IE
            .Visible = True
            .Navigate Cells(i, "A")
            Do Until .ReadyState = 4: DoEvents: Loop
            Do While .Busy: DoEvents: Loop
         End With
    Next i

    Set IE = Nothing
    
End Sub

.

 

[gjorfindel]

Merhaba,

Bu şekilde deneyin.

Sub Ac()
    
    Dim IE As Object, i As Long

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Set IE = CreateObject("InternetExplorer.Application")
        With IE
            .Visible = True
            .Navigate Cells(i, "A")
            Do Until .ReadyState = 4: DoEvents: Loop
            Do While .Busy: DoEvents: Loop
         End With
    Next i

    Set IE = Nothing
    
End Sub

.

Hocam çok teşekkürler Bu kod IE ile açıyor ve her linki ayrı sayfalarda açıyor. Ben aşağıdaki kodu buldum fakat bu kod ile de sadece köprü oluşturulmuş linkleri chrome'da her linki ayrı sekmelerde açabiliyorum. Sizin gönderdiğiniz kodda ise link olmasa bile açıyor. Bunları birleştirmenin bir yolu var mı acaba?

    Dim hl As Hyperlink
    On Error Resume Next
    For Each hl In Selection.Hyperlinks
        hl.Follow
    Next hl

 

[Ömer]

İstediğinizi tam anlayamadım.

Bu şekilde deneyin.

Sub Chr_Ac()

    Dim chr As String
  
    chr = "C:\Program Files\Google\Chrome\Application\chrome.exe"
  
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Shell (chr & " -url " & Cells(i, "A"))
    Next i
  
End Sub

.

 

[gjorfindel]

İstediğinizi tam anlayamadım.

Bu şekilde deneyin.

Sub Chr_Ac()

    Dim chr As String
  
    chr = "C:\Program Files\Google\Chrome\Application\chrome.exe"
  
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Shell (chr & " -url " & Cells(i, "A"))
    Next i
  
End Sub

.

Çok teşekkürler tam olarak istediğim buydu. Ne istediğini bilmeyince anlatması da zor oluyor takdir edersiniz ki Kusuruma bakmayın.

İyi çalışmalar dilerim.

 

[alpkilic]

Merhaba ;
Kodun şu kısmı hata veriyor ...

Shell (chr & " -url " & Cells(i, "A"))

 

[yasin85]

Merhaba,
Toplu link açma işlemi yapıyoruz fakat browser sekmeler kasma yapıyor.
her 30 satıra geldiğinde yeni browser acıp 30 tane den sonra tekrar yeni browser acıp bitene satırdaki veri bitene kadar yapa bilirmiyiz.
bu konuda desteklerinizi bekliyoruz.

Sub Web_Sayfası_Aç1()
Dim i%
For i = 1 To Range("A4000").End(3).Row
If Cells(i, 1) <> "" Then
Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe " & Cells(i, 1) & "", 1

End If
Next i
i = emty
End Sub

 

[yasin85]

Herkese Merhaba,

Konumuz günceldir.
Değerli desteklerinizi bekleriz.

 

[yasin85]

Merhaba,

Bu şekilde deneyin.

Sub Ac()
   
    Dim IE As Object, i As Long

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        Set IE = CreateObject("InternetExplorer.Application")
        With IE
            .Visible = True
            .Navigate Cells(i, "A")
            Do Until .ReadyState = 4: DoEvents: Loop
            Do While .Busy: DoEvents: Loop
         End With
    Next i

    Set IE = Nothing
   
End Sub

.

Merhaba,

Bu kod gibi her sayfa tek tek açılsın fakat bu işlemi Chrome çalışması mümkün mü ?

 

[gokkusahı]

Merhaba,
Elimdeki web linklerini sizin yayınladığınız bu kod ile topluca açıyorum.
Sub Chr_Ac()

Dim chr As String

chr = "C:\Program Files\Google\Chrome\Application\chrome.exe"

For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Shell (chr & " -url " & Cells(i, "A"))
Next i

End Sub

Ancak benim ihtiyacım bu sayfaları açarken de o sayfaların içinde Turbobit gibi indirme linkleri var (turbobit linki görünce otomatik sayfa açma), bu toplu açma sırasında bu linkleride açmak için bir yardımcı olursanız sevinirim.

 

[Ömer]

Merhaba,

"Turbobit" bu konu hakkında bilgim yok. Örnek dosya eklemeniz mümkün mü.

 

[gokkusahı]

https://turkuk.biz/diskografi/z/zeynep-onat bu sayfalar sizin makronuzla birlikte toplu açılırken, buradaki turbobit yazısını görünce oradaki linkteki sayfayı otomatik açması mümkün mü acaba?

 

[burcuucsknn]

Merhaba, yanıtlarınız için çok teşekkürler

Aşağıdaki koda sayfaları açarken 30 saniyelik aralıklarla açılmasını sağlayan kodda ekleyebilir misiniz?

Sub Web_Sayfası_Aç1()
Dim i%
For i = 1 To Range("A4000").End(3).Row
If Cells(i, 1) <> "" Then
Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe " & Cells(i, 1) & "", 1

End If
Next i
i = emty
End Sub



Çok teşekkür ederim

 

[Korhan Ayhan]

End If satırının üstüne aşağıdaki satırı ekleyip deneyiniz.

Application.Wait Now + TimeSerial(0, 0, 30)