• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile e-mail gönderme

  • Konbuyu başlatan Konbuyu başlatan turgay25
  • Başlangıç tarihi Başlangıç tarihi
Günaydın;
Şu an bu dosya işimi görüyor. Şimdilik doğum günlerinde tarihe göre mail göndermesini istiyorum. Yardımınız için şimdiden teşekkür ederim.
 
yardımcı olmak isteyenler çıkacaktır. ama ne istediğini daha açık ve net anlatmalısın diye düşünüyorum.
 
Eklediğim makro F sutünunda ki tarihi bugüne eşit ise C sütununda ki mail adresine mail gönderiyor. Ancak benim yapmak istediğim F sütununda doğum günü tarihleri yazacağı için buna göre ayarlayıp mail göndermelidir. Bunun için nasıl bir değişiklik yapmalıyım?
 
tarih hanesindeki yıl değerini kaldırın. Sadece gün ve ay kalsın gün ve ay eşit olunca mail atsın.
 
Bilgi için teşekkür ederim ama işe yaramadı.
 
fireman64' Alıntı:
tarih hanesindeki yıl değerini kaldırın. Sadece gün ve ay kalsın gün ve ay eşit olunca mail atsın.
Genişletmek için tıkla ...
Fireman 'a teşekkür ederim. İlk başta doğru kuramadığım için çalışmamıştı. Ekteki şekilde çalışıyor. İlgilenen herkese teşekkürler.

Sub dgunuEmail()
Dim OutApp As Outlook.Application

Dim NewMail As Outlook.MailItem

Dim noE As Integer, i As Integer

noE = Cells(65536, 6).End(xlUp).Row

For i = 1 To noE
tarih = Format(Now, "dd.mm")
If tarih = Format(Cells(i, 6), "dd.mm") Then

Set OutApp = New Outlook.Application

Set NewMail = CreateItem(olMailItem)

With NewMail

.To = Cells(i, 3).Text

.Subject = "Doğum Gününüz Kutlu Olsun!"

.Body = "RAS Kuaför ailesi olarak doğum gününüzü kutlar, bir ömür sağlıklı mutlu yıllar dileriz."

.Save

.Send

End With

Set NewMail = Nothing

Set OutApp = Nothing

End If
 
arkadaşlar iyi akşamlar. her ay kullandığım bir çalışmam var.yaklaşık 5000 cariye mutabakat formu gönderiyorum. formu mail atıyor sorunsuz bir şekilde çalışıyor.ben bunu biraz daha geliştirmek istiyorum.
yapmak istediğim şu: formu pdf e çevirip mail atıyor ama buna ait carinin ekstresini de ayrı bir sayfada pdf e çevirip mail atması. ekstrelerin tamamı ayrı bir sayfada mevcut ama istenilen aralığı nasıl tanımlayacağımı bilemedim. örnek: B ltd şti ne ait form ekrandayken mail gönder derken aynı zamanda ekstre sayfasından A21:U37 aralığını da ayrı bir pdf sayfası olarak mail atması. yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

Son düzenleme:
Ekstreleri ayırıp pdf formatında kaydetiyor ama mail atmıyor. Bu kısmı ekleyebilirseniz işiniz çözülür zannedersem. Zamanım olursa bu kısmı da eklemeye çalışacağım.
Kod: 
Sub ExtreAyir()
Dim arr()
For i = 1 To ActiveSheet.UsedRange.Rows.Count 
    If Cells(i, "g") = "C A R İ  H E S A P  E K S T R E S İ" Then
        c = c + 1
        ReDim Preserve arr(1 To c)
        arr(c) = i
    End If
Next
On Error Resume Next
For j = 1 To UBound(arr)
    b = arr(j)
    s = arr(j + 1) - 1
    dosya_adı = ActiveWorkbook.Name
    'xls dosyasında hangi aralığın PDF'ye dönüştürüleceğini belirledik yani B1:I52
    Range("a" & b & ":u" & s).Select
    ' PDF dosyasını isimlendirmek için ad tanımlıyoruz:
    Musteri_adi = Cells(arr(j) + 4, 5)
    ' PDF dosyası oluşturuyoruz.
    ' PDF'nin kayıt yeri XLS dosyası neredeyse orada olacak.
    
    Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
    Application.ThisWorkbook.Path & "\" & Musteri_adi & "---  " & "Mutabakat Formu" & strdate, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    'OpenAfterPublish:=True değerini False seçersek kayıt sonrası PDF otomatik açılmayacak.
Next
End Sub
 
Üstad ben iki makroyu birleştirmeye çalıştım. ama yapamadım. yardımlarınızı bekliyorum. teşekkür ederim.
 
Bu şekilde dener misiniz ?
Kod: 
Sub ExtreAyir()
Dim arr()
For i = 1 To ActiveSheet.UsedRange.Rows.Count 
    If Cells(i, "g") = "C A R İ  H E S A P  E K S T R E S İ" Then
        c = c + 1
        ReDim Preserve arr(1 To c)
        arr(c) = i
    End If
Next
'On Error Resume Next
Sheets("EKSTRE").Select
For j = 1 To UBound(arr)
    b = arr(j)
    s = arr(j + 1) - 1
'    dosya_adı = ActiveWorkbook.Name
    'xls dosyasında hangi aralığın PDF'ye dönüştürüleceğini belirledik yani B1:I52
    Range("a" & b & ":u" & s).Select
    ' PDF dosyasını isimlendirmek için ad tanımlıyoruz:
    Musteri_adi = Cells(arr(j) + 4, 5)
    ' PDF dosyası oluşturuyoruz.
    ' PDF'nin kayıt yeri XLS dosyası neredeyse orada olacak.
    
    Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
    Application.ThisWorkbook.Path & "\" & Musteri_adi & "---  " & "Mutabakat Formu", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    'OpenAfterPublish:=True değerini False seçersek kayıt sonrası PDF otomatik açılmayacak.

    Set MailBul = Sheets("FAKS").Columns(1).Find(Musteri_adi)
    Set OutApp = New Outlook.Application
        Set NewMail = CreateItem(olMailItem)
            With NewMail
                .To = Sheets("FAKS").Cells(MailBul.Row, "l")
                .Subject = "deneme"
                .Body = "Sayın Yetkili Bu mail ekte görmüş olduğunuz mail bilgi için gönderilmiştir."
                .Attachments.Add ThisWorkbook.Path & "\" & Musteri_adi & "---  " & "Mutabakat Formu.pdf"
                .Display
'                .Send
             End With
        Set NewMail = Nothing
        Set OutApp = Nothing
Next
End Sub
 
üstad merhaba. kodu denedim ama Set OutApp = New Outlook.Application satırında hata mesajı verdi. 3. satıra Dim OutApp As Object satırını ekleyince çalıştı. ancak bu sefer ekstredeki tüm carileri pdf olarak kaydetti ve mailler toplu bir şekilde gönderilmek üzere hazırlandı. ancak bu şekilde çalışması benim sorunumu çözmeyecek. çünkü ben mutabakat formunu ve ekstreyi tek tek göndermek istiyorum. yani bir cariye mutabakat formu gönderdiğim zaman ekstreyi de buna eklemesini istiyorum. bunu iki ayrı mailde yapmasının sakıncası yok. ama formu tek tek gönderirken ekstrelerin hepsini birden hazırlayıp göndermesi uygun olmuyor. üstadım bu iki makroyu bir butonda birleştirebilirsek çok güzel olacak. yardımlarınız için teşekkür ederim.
 
Öncelikle aşağıdaki kod yardımı ile ekstreleri ayırıp pdf formatında kaydetin. Burada dikkat edeceğiniz husus, pdf olarak kaydettiğiniz dosya ismi ile FORM sayfası B14 hücresinde yazılı olan firma isminin aynı olması bu yüzden kod içinde pdf olarak kaydeterken verdiğiniz dosya ismini biraz düzenledim.
Kod: 
Sub ExtreAyir()
Dim arr()
Sheets("EKSTRE").Select

For i = 1 To ActiveSheet.UsedRange.Rows.Count '284
    If Cells(i, "g") = "C A R İ  H E S A P  E K S T R E S İ" Then
        c = c + 1
        ReDim Preserve arr(1 To c)
        arr(c) = i
    End If
Next
'On Error Resume Next
For j = 1 To UBound(arr)
    b = arr(j)
    s = arr(j + 1) - 1
'    dosya_adı = ActiveWorkbook.Name
    'xls dosyasında hangi aralığın PDF'ye dönüştürüleceğini belirledik yani B1:I52
    Range("a" & b & ":u" & s).Select
    ' PDF dosyasını isimlendirmek için ad tanımlıyoruz:
    Musteri_adi = Cells(arr(j) + 4, 5)
    ' PDF dosyası oluşturuyoruz.
    ' PDF'nin kayıt yeri XLS dosyası neredeyse orada olacak.
    
    Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
   [color=red]ThisWorkbook.Path & "\deneme\" & Musteri_adi & " Mutabakat Formu"[/color], Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    'OpenAfterPublish:=True değerini False seçersek kayıt sonrası PDF otomatik açılmayacak.

Next
End Sub
Daha sonra aşağıdaki kod yardmıyla hem FORM sayfası görüntüsünü hem de ekstrenizi posta içine ekleyebilirsiniz.
Kod: 
Sub Bilgileri_Tablo_Olarak_Gonder()

On Error Resume Next
Dim saydeneme, saymaillistesi As Variant
Dim deneme As Range

sayfa_adı = ActiveSheet.Name
strdate = Format(Now, "dd-mm-yyyy ")
Sheets("FORM").Select
Set deneme = ActiveSheet.Range("A1:I45")
deneme.Select

ActiveWorkbook.EnvelopeVisible = True
 
With ActiveSheet.MailEnvelope
      .Introduction = ""
      .Item.To = [J2]
      .Item.CC = ""
      .Item.Subject = "Cari Mutabakatı Hakkında"
      .Item.Attachments.Add ThisWorkbook.Path & "\deneme\" & Sheets("FORM").[B14] & " Mutabakat Formu.pdf"
      '.Item.Send
      .Item.Display
   End With
Application.ScreenUpdating = True
End Sub

Not:
* Ben pdf dosyalarının bulunduğu yolu deneme isimli yeni bir klasör içinde açtım, siz kendinize göre ayarlayabilirsiniz.
* Item.Display satırını kapatıp Item.Send satırını aktif hale getirmeyi unutmayın.
 
hocam çok teşekkür ederim. emeğinize sağlık. bir yerde hata yapıyor .örneğin e ltd şirketini gönderirken a ltdnin eksteresini 4 tane b c d ve e şirketinin eksteresini de birer tane ekleyerek gönderiyor. onu çözeceğim. tekrar teşekkür ederim..
 
Merhaba

Email gönderme işlemi sırasında .body = kısmına excelde macro tarafından kopyalanan bir tabloyu nasıl ekleyebilirim .body=Selection.PasteSpecial yazdım olmadı

Sub copy()
' copy Macro
Sheets("tablo").Select
Range("A5").Select
Selection.CurrentRegion.Select
Selection.copy
Application.CutCopyMode = False

Dim oOApp As Object
Dim oMail As Object

Set oOApp = CreateObject("Outlook.Application")
Set oMail = oOApp.CreateItem(0)

On Error Resume Next

With oMail
.to = "fbayn@hotmail.com"
.CC = ""
.BCC = ""
.Subject = "tablo"
.Body = Selection.PasteSpecial 'olmadı
.Send
End With

On Error GoTo 0

Set oMail = Nothing
Set oOApp = Nothing

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst