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
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
