İnternet sitesinden mail adreslerini ve telefon numaralarını Excel sayfasına çekmek

[mly032]

Ankara'da OSB internet sitesinde firmaların mail adresi ve telefon numaraları mevcuttur. Bu mail adreslerini Excel sayfasına almak ve oluşturmuş olduğum konuyu mail olarak firmalara atmak istiyorum bunu tek tek yerine VBA ile nasıl yapabilirim.baska öneriniz var mıdır?

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu kullanarak ilgili verileri excele aldırabilirsiniz.
Toplu mail ile ilgili de daha önceden işlenmiş konuları inceleyiniz.

Sub kod()
Set x = CreateObject("MSXML2.XMLHTTP")
Set h = CreateObject("htmlFile")
Set h1 = CreateObject("htmlFile")
With x
    .Open "GET", "https://www.aosb.org.tr/firmalarimiz", False
    .Send
End With

h.body.innerhtml = x.responsetext
ReDim tablo(1 To h.getelementbyid("brands").Rows.Length, 1 To 3)
tablo(1, 1) = "Firma Adı"
tablo(1, 2) = "Telefon"
tablo(1, 3) = "E-posta"
For a = 1 To h.getelementbyid("brands").Rows.Length - 1
    adr = Split(h.getelementbyid("brands").Rows(a).Cells(1).all(0).href, ":.")(1)
    With x
        .Open "GET", "https://www.aosb.org.tr" & adr, False
        .Send
    End With
    h1.body.innerhtml = x.responsetext
    veri = Split(h1.getelementsbyclassname("brand-content")(0).innertext, vbLf)
    tablo(a + 1, 1) = veri(0)
    For Each v In veri
        If InStr(1, v, "elefon") > 0 Then
            tablo(a + 1, 2) = Split(v, ": ")(1)
        ElseIf InStr(1, v, "@") > 0 Then
            tablo(a + 1, 3) = Split(v, ": ")(1)
        End If
    Next
    DoEvents
Next
Range("D1").Resize(UBound(tablo), UBound(tablo, 2)).Value = tablo
MsgBox "İşlem tamam"
End Sub