mail adreslerini almak

[ozyilmaz1]

Merhaba ;

Foruma daha önce Kemal Demir tarafından gönderilen kodu denedim. yeni istediklerimle birlikte bu konu herhalde buraya daha uygun diye düşündüm.

Sorun : Bir sutundaki e-mail adresi içeren köprülerin, e-mail adreslerini ikinci sutuna yazdırabilmek.

Kod:

For x = 2 To [a65536].End(3).Row
Cells(x, 2) = Range("a" & x).Hyperlinks.Item(1).Address
Next



Bu çözüm benim bir sorunumu çözme konusunda ilk adım olmuş. Bende de aynı dosyadan var ama, A sütünundaki tüm veriler hyperlink içermeyebiliyor. For Next döngüsü hyperlink olmayan hücreye geldiğinde makro haliyle hata veriyor. Bunu çözebilir miyiz ?

Bir de makronun çıktısı mailtozyilmaz@excel.web.tr?subject=Universite%20 Yonetim%20Sayfasindan%20Yaziyorum
şeklinde .
Bunu saddece mail adresi şeklinde yazdırabilir miyiz ? Gerçi dosya çıktıktıktan sonra "?" ne göre metni bölebilir ve "mailto:" metnini silebilirim ama makro içinde çözebilir miyiz ?

Ekte örnek dosya var, tabii ki a sütünuda yüzlerce veri var.

Teşekkürler.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub mailal()
For a = 1 To [a65536].End(3).Row
If Range("a" & a).Hyperlinks.Count > 0 Then
Cells(a, "b") = Replace(Range("a" & a).Hyperlinks.Item(1).Address, "mailto:", "")
End If
Next
End Sub

 

[ozyilmaz1]

Teşekkür ediyorum.

çıkan sonuç:
ozyilmaz@excel.com.tr?subject=Universite%20Yonetim%20Sayfasindan%20Yaziyorum

şu subject kısmını da çıkartabilirsek ( ?'den sonraki kısım) tam olacak .

Saygılar.

Aşağıdaki kodu deneyin.

Sub mailal()
For a = 1 To [a65536].End(3).Row
If Range("a" & a).Hyperlinks.Count > 0 Then
Cells(a, "b") = Replace(Range("a" & a).Hyperlinks.Item(1).Address, "mailto:", "")
End If
Next
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub mailal()
For a = 1 To [a65536].End(3).Row
If Range("a" & a).Hyperlinks.Count > 0 Then
adres = Split(Replace(Range("a" & a).Hyperlinks.Item(1).Address, "mailto:", ""), "?")
Cells(a, "b") = adres(0)
End If
Next
End Sub

 

[ozyilmaz1]

Tamamdır.
Çok teşekkürler ve saygılar.

Aşağıdaki gibi deneyin.

Sub mailal()
For a = 1 To [a65536].End(3).Row
If Range("a" & a).Hyperlinks.Count > 0 Then
adres = Split(Replace(Range("a" & a).Hyperlinks.Item(1).Address, "mailto:", ""), "?")
Cells(a, "b") = adres(0)
End If
Next
End Sub