Excelden mail atarken uyarı kaldırma

[Sinan2618]

Arkadaşlar merhaba,

Ekteki dosya üzerinden mail gönderimi yapmak istiyoruz ama girilen her adresi için tek tek onay istiyor bu onayı nasıl kaldırabiliriz?

Teşekkürler,

 

[askm]

Sub kod()
Application.ScreenUpdating = False
Dim H
'NOT: TOOLS-REFERENCES TIKLA
'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI

For H = 2 To [A65536].End(3).Row
If Cells(H, "A") <> "" Or _
Cells(H, "A") Like "*@*" Then

With Application
.EnableEvents = True
End With
Dim objOutlook As Object
Dim objMail As Object
Dim i As Long, NoA As Long
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = Cells(H, "A").Value
'.CC = ""
.Subject = "Stop, Fiyat ve Aksiyon "
.Body = Cells(H, "B").Value
.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End If
Next H
Application.ScreenUpdating = True
End Sub

 

[Sinan2618]

Sub kod()
Application.ScreenUpdating = False
Dim H
'NOT: TOOLS-REFERENCES TIKLA
'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI

For H = 2 To [A65536].End(3).Row
If Cells(H, "A") <> "" Or _
Cells(H, "A") Like "*@*" Then

With Application
.EnableEvents = True
End With
Dim objOutlook As Object
Dim objMail As Object
Dim i As Long, NoA As Long
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = Cells(H, "A").Value
'.CC = ""
.Subject = "Stop, Fiyat ve Aksiyon "
.Body = Cells(H, "B").Value
.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End If
Next H
Application.ScreenUpdating = True
End Sub

Çok teşekkürler yarın ilk iş deneyeceğim. Ayrıca bu kodda diğer sütunları nasıl eklerim örneğin burada A sütununa girdiğim mail adresini B sütünündeki veriyi mail atmakta. Ben buraya c,d,f,g,j gibi sütunları eklemek istersem ne yapmalıyım?

 

[askm]

.Body = Cells(H, "B").Value kısmına araya & " " & ekleyerek istediğiniz hücreleri alabilirsiniz.
.Body = Cells(H, "B").Value & " " & Cells(H, "c").Value gibi.
eğer alt satıra yazsın istiyorsanız..
.Body = Cells(H, "B").Value & Chr(10) & Cells(H, "c").Value şeklinde devam edin.

 

[Sinan2618]

.Body = Cells(H, "B").Value kısmına araya & " " & ekleyerek istediğiniz hücreleri alabilirsiniz.
.Body = Cells(H, "B").Value & " " & Cells(H, "c").Value gibi.
eğer alt satıra yazsın istiyorsanız..
.Body = Cells(H, "B").Value & Chr(10) & Cells(H, "c").Value şeklinde devam edin.

Teşekkürler tam istediğim gibi olmuş. Size son olarak şunu sormak istiyorum 1. satırdaki verileri başlık olarak nasıl eklerim. Örneğin A1'de Konu yazsın A2'de satışlar ben mail tuşuna bastığım zaman bu iki veri altalta gitsin. yukarıdaki mesajınızda alta geçirme kodunu vermişsiniz ancak bunu çoklu sütunlarda nasıl yaparım çözemedim.

 

[Sinan2618]

Günceldir.

 

[askm]

İstediğiniz işlem A1 de Konu A2 satışlar olması bu kodun mantığına aykırı olur. Bu kod toplu mail atmak için. Eğer A sütununda mail adresi B sütununda konu C sütununda satışlar olsun isterseniz o şekilde ayarlama yapayım. Sırası ile listede olanlara tek tek mail atar kod.