• DİKKAT

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

Mevcut Makro uzerinde duzeltme yardim!!

Katılım
27 Mayıs 2006
Mesajlar
193
Excel Vers. ve Dili
2010
Merhabalar Mail gondermek icin kullandigim bir excel calismam var.
Ancak asagidaki gibi bir sorunum var. Yardimlarinizi rica ediyorum. Saygilarimla
Bu dosyada olustulan makroya gore ;
Mail 1 icin attachmemets olarak Dosya 1
Mail 2 icin attachmemets olarak Dosya 2
Mail 3 icin attachmemets olarak Dosya 3 'un ek olarak eklenmesi gerekiyor.
Ancak mevcut makro
Mail 1 icin Dosya 1
Mail 2 icin Dosya 1+Dosya 2
Mail 3 icin Dosya 1+Dosya 2+ Dosya 3 ek olarak ekleniyor.
Her mail icin sadece ayni satirdaki dosya eklenmesi icin makroyu nasil degistirmeliyim.
Makroyu calistirmadan once:
.Attachments.Add "C:\Users\Sedat.Coskun\Desktop\Mail Gonder\Attachments\" & sb.Range("b" & a) & ".jpg"
dosyanin masaustune kayit edilmesi ve kirmizi alanin kendinize gore duzenlenmesi gerekmektedir.

Makro:
Sub SendMail()
'2002-2013 excel versiyonlari ile kullanilabilir
Dim Sendrng As Range
Dim mm As Worksheet
Dim objOutlook As Object
Dim objMail As Object
Dim sb As Worksheet
Set mm = Sheets("Mail Message")
Set sb = Sheets("Send Mail")

aa = sb.[b65536].End(3).Row
For a = 13 To aa
'mm.Cells(7, "b") = sb.Cells(a, "b")
'mm.Cells(9, "b") = sb.Cells(a, "e")
'mm.Cells(15, "b") = sb.Cells(a, "c")
'mm.Cells(15, "d") = sb.Cells(a, "d")
Sheets("imza").Select

On Error GoTo StopMacro

With Application
.ScreenUpdating = False
.EnableEvents = False
End With


Set Sendrng = Selection

'Mail Olustur
With Sendrng

ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope


' Mail icerigi
.Introduction = mm.Cells(2, "a")

Dim i As Long, NoA As Long
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With .Item

.To = sb.Range("c" & a)
.CC = sb.Range("d" & a)
.BCC = ""
.Subject = sb.Range("e" & a)
.Attachments.Add "C:\Users\Sedat.Coskun\Desktop\Mail Gonder\Attachments\" & sb.Range("b" & a) & ".jpg"
'.Save
'.Display
.Send
End With
End With
End With


StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False
Set objMail = Nothing
Set objOutlook = Nothing
Next a
sb.Select
Application.ScreenUpdating = True
MsgBox " Mailler Gonderildi. S.C "

End Sub
 

Ekli dosyalar

Geri
Üst