outlook a excelden mail adresi cektirmek

[kneehot]

arkadaslar merhaba. yapmak istediğim outlook a bır buton ile mail.xlsm dosyasındaki mail sayfasındaki c2:c11 aralıgındakı 10 maıl adresını eklemek. dosyada ekledım. tum yardımlara cok tesekkurler.

 

[hamitcan]

Aşağıdaki makale işinizi görür belki.
http://support.microsoft.com/kb/295664/tr

 

[Murat OSMA]

Excel'deki rehber tablonuzu bu şekilde hazırlayıp, aşağıdaki kodlar ile Adres defterinize Excel'den kişi eklemesi yapabilirsiniz...


' Excel sayfa başlıkları:
'1. satırda başlıklar...
' A sütunu: Adı
' B sütunu: Soyadı
' C sütunu: Email
' D sütunu: Firma
' E sütunu: İş tel
' F sütunu: İş Fax
' G sütunu: Ev tel
' H sütunu: Cep tel


•Kodlar Bülent ÖZTÜRK'e aittir.
• Bu kodları kullanabilirsiniz;

Dim ExcelOUT As Boolean
Sub OutlookaExceldenAdresEkle()
    Dim ekle As Boolean
    ekle = ExcelAdresEkle
End Sub

Function ExcelAdresEkle() As Boolean    
    On Error GoTo Hata
    
    Dim Satir As Long, Sutun As Long, Say As Long, KisiDetay As Variant
    Dim ExcelKisi As Object, Kisi_ad As String, Kisi_soyad As String
    Dim Kisi_mail As String, Kisi_firma As String, Kisi_firma_tel As String
    Dim Kisi_firma_fax As String, Kisi_ev_tel As String, Kisi_cep_tel As String
    
    Satir = Sayfa1.Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Count
    Sutun = Sayfa1.Range(Range("A1"), Range("IV1").End(xlToLeft)).Count
    ReDim KisiDetay(1 To Satir, 1 To Sutun)
    
    KisiDetay = Range(Cells(2, 1), Cells(Satir + 1, Sutun))
    
    Dim olApp As Object ' Outlook.Application
    Set olApp = VBA.CreateObject("Outlook.Application") ' GetOutlookApp
    
    Say = 1
    
    Do Until Say = Satir
    
      Kisi_ad = KisiDetay(Say, 1)
      Kisi_soyad = KisiDetay(Say, 2)
      Kisi_mail = KisiDetay(Say, 3)
      Kisi_firma = KisiDetay(Say, 4)
      Kisi_firma_tel = KisiDetay(Say, 5)
      Kisi_firma_fax = KisiDetay(Say, 6)
      Kisi_ev_tel = KisiDetay(Say, 7)
      Kisi_cep_tel = KisiDetay(Say, 8)
    
      Set ExcelKisi = olApp.CreateItem(2)
    
      With ExcelKisi
        .FirstName = Kisi_ad
        .LastName = Kisi_soyad
        .Email1Address = Kisi_mail
        .CompanyName = Kisi_firma
        .BusinessTelephoneNumber = Kisi_firma_tel
        .BusinessFaxNumber = Kisi_firma_fax
        .HomeTelephoneNumber = Kisi_ev_tel
        .MobileTelephoneNumber = Kisi_cep_tel
      End With
    
      ExcelKisi.Close 0 '
      Say = Say + 1
    Loop
    
    ExcelAdresEkle = True
    GoTo Bitir
    
Hata:
    ExcelAdresEkle = False
    
Bitir:
    Set ExcelKisi = Nothing
    If ExcelOUT Then
      olApp.Quit
    End If
    Set olApp = Nothing
End Function

Function GetOutlookApp() As Object
    On Error Resume Next
    Set GetOutlookApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set GetOutlookApp = CreateObject("Outlook.Application")
        ExcelOUT = True
    End If
    On Error GoTo 0
End Function

 

[kneehot]

Excel'deki rehber tablonuzu bu şekilde hazırlayıp, aşağıdaki kodlar ile Adres defterinize Excel'den kişi eklemesi yapabilirsiniz...


' Excel sayfa başlıkları:
'1. satırda başlıklar...
' A sütunu: Adı
' B sütunu: Soyadı
' C sütunu: Email
' D sütunu: Firma
' E sütunu: İş tel
' F sütunu: İş Fax
' G sütunu: Ev tel
' H sütunu: Cep tel


•Kodlar Bülent ÖZTÜRK'e aittir.
• Bu kodları kullanabilirsiniz;

Dim ExcelOUT As Boolean
Sub OutlookaExceldenAdresEkle()
    Dim ekle As Boolean
    ekle = ExcelAdresEkle
End Sub

Function ExcelAdresEkle() As Boolean    
    On Error GoTo Hata
    
    Dim Satir As Long, Sutun As Long, Say As Long, KisiDetay As Variant
    Dim ExcelKisi As Object, Kisi_ad As String, Kisi_soyad As String
    Dim Kisi_mail As String, Kisi_firma As String, Kisi_firma_tel As String
    Dim Kisi_firma_fax As String, Kisi_ev_tel As String, Kisi_cep_tel As String
    
    Satir = Sayfa1.Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Count
    Sutun = Sayfa1.Range(Range("A1"), Range("IV1").End(xlToLeft)).Count
    ReDim KisiDetay(1 To Satir, 1 To Sutun)
    
    KisiDetay = Range(Cells(2, 1), Cells(Satir + 1, Sutun))
    
    Dim olApp As Object ' Outlook.Application
    Set olApp = VBA.CreateObject("Outlook.Application") ' GetOutlookApp
    
    Say = 1
    
    Do Until Say = Satir
    
      Kisi_ad = KisiDetay(Say, 1)
      Kisi_soyad = KisiDetay(Say, 2)
      Kisi_mail = KisiDetay(Say, 3)
      Kisi_firma = KisiDetay(Say, 4)
      Kisi_firma_tel = KisiDetay(Say, 5)
      Kisi_firma_fax = KisiDetay(Say, 6)
      Kisi_ev_tel = KisiDetay(Say, 7)
      Kisi_cep_tel = KisiDetay(Say, 8)
    
      Set ExcelKisi = olApp.CreateItem(2)
    
      With ExcelKisi
        .FirstName = Kisi_ad
        .LastName = Kisi_soyad
        .Email1Address = Kisi_mail
        .CompanyName = Kisi_firma
        .BusinessTelephoneNumber = Kisi_firma_tel
        .BusinessFaxNumber = Kisi_firma_fax
        .HomeTelephoneNumber = Kisi_ev_tel
        .MobileTelephoneNumber = Kisi_cep_tel
      End With
    
      ExcelKisi.Close 0 '
      Say = Say + 1
    Loop
    
    ExcelAdresEkle = True
    GoTo Bitir
    
Hata:
    ExcelAdresEkle = False
    
Bitir:
    Set ExcelKisi = Nothing
    If ExcelOUT Then
      olApp.Quit
    End If
    Set olApp = Nothing
End Function

Function GetOutlookApp() As Object
    On Error Resume Next
    Set GetOutlookApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set GetOutlookApp = CreateObject("Outlook.Application")
        ExcelOUT = True
    End If
    On Error GoTo 0
End Function

murat bey ilginiz için cok tesekkurler ama yapmaya calıstıgım bır maılı 10 ar kısılık gruplar olarak gondermek. bunun ıcın outloook ta hazırladıgım maıle exceldekı adreslerı cekmeye calısıyorum hatta bcc kısmına. gonderılecek maıl adreslerı sureklı kullanılan adresler olmadıgı ıcın deftere eklemek benım ıcın cozum yolu degıl. yınede yardımınız ıcın cok tesekkurler.

 

[kneehot]

Aşağıdaki makale işinizi görür belki.
http://support.microsoft.com/kb/295664/tr

sayın hamitcan sanırım yapmak ıstedıgımı tam anlatamadım kusura bakmayın. yapmak ıstedıgım kısıler kısmına adreslerı cekıp kaydetmek degıl gonderıme hazırlanmıs maılın bcc kısmına excelın c2:c11 arasındakı maıl adreslerını almak sonra gonder deyınce o adreslere hazırlanan maıl gonderılecek.

 

[baydeniro]

Murat Osma üstadın selamlar. Verdiğiniz kodu uyguladım ama Excel sayfasındaki mail adresini Outlooka aktarmadı. Neyi eksik & yanlış yapmış olabilirim acaba ?