maille bilgilendirme

[sino06]

herkese slm,

Excel de ki bir dosyada değişiklik yapılıp kaydedildikten sonra mail adresleri belirtilen kişilere mail gönderen makro yazmam lazım.
yardımınızı bekliyorum.
kolay geklsin

 

[Emir Hüseyin Çoban]

. . .

Merhaba.
Ekteki dosyayı inceleyiniz.
İsteğiniz ile ilgili biraz daha bilgi verseydiniz, daha net bir çalışma yapabilirdik.
Kırmızı ile belirttiğim yere mail adreslerini girin.

Boş bir modüle:

Sub AUTO_OPEN()
bir = MsgBox(" Mc Outlook Açmak İstiyor Musunuz ? ", vbYesNo, " Hüseyin Çoban ")
If bir = vbNo Then Exit Sub
Shell "outlook"
End Sub

Sub KOD_mail_gönder()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
yer = "C:\"
For i = 1 To Len(ThisWorkbook.Name)
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Dosya = Mid(ThisWorkbook.Name, 1, i - 1)
uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
End If
Next
ActiveWorkbook.Save
Application.DisplayAlerts = False
Yedek_Dosya_Adı = Dosya & uzanti
Kayıt_Yeri = yer & Yedek_Dosya_Adı
On Error Resume Next
DosyaSistemi.CopyFile ThisWorkbook.FullName, Kayıt_Yeri

[COLOR="Red"]adresler = "bir@mail.com;iki@mail.com"[/COLOR]

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Dim objOutlook As Object
Dim objMail As Object
Dim NoA As Long
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = adresler
.Subject = "oto mail"
.Attachments.Add Kayıt_Yeri
.Save
.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
Kill Kayıt_Yeri
Application.ScreenUpdating = False
End Sub

. . .