Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Diğer Office Programları => Microsoft Outlook Soru ve Örnek Kodları => Konuyu başlatan: demir.zined - 24 Eylül 2012, 23:19:21

Başlık: Outlook Açıldığında Excel'deki Listeye Özel Günlerinde Mail,
Gönderen: demir.zined - 24 Eylül 2012, 23:19:21
Outlook açıldığında exceldeki listeye özel günlerinde mail atmak (Bunu için en kullanışlı yol başlangıç'a outlook'u koymak).
Açılışta ve kapanışta tarihleri kontrol edip, kapanırken outlook açmayacağınız gün sayısını soruyor o tarihler arasında özel günü olan varsa mailini kapanırken sizden onay alarak gönderiyor.

Verdiğim koddan sonra aşağıdaki uyarlamalarıda kolayca yapabilirsiniz,
isterseniz excelde ve koddaki mesajda küçük değişiklikler yapıp çalışanlarınıza bu gün ne yaptın maili gönderebilirsiniz veya eklemelerle toplu değil kişiye özel mail atabilirsiniz.


c:\PersonelOzelGunleri.csv(excelde oluşturduğunuz tabloyu .csv olarak kaydedin)
içeriği örnek olarak aşağıda verilmiştir, listenizi oluşturun.

sıra;adı soyadı;mail adresi;durum(e/d);gün;ay
1;demir zined;demir.zined@xxx.com;d;13;9


Kodu sadece yapıştırmanız yeterli değişiklik yapmak istersenizde kolay olacaktır (outlook kod bölümüne).

Private Sub Application_Startup()
On Error Resume Next

Dim MyDate, MyDay, MyMonth, MyItem
Dim InputData
MyDate = Date
MyDay = Day(MyDate)
MyMonth = Month(MyDate)
MyDate1 = (MyDay & "." & MyMonth)

Open "c:\PersonelOzelGunleri.csv" For Input As #1
Do While Not EOF(1)
Line Input #1, InputData

virgul = InStrRev(InputData, ";", -1)
MidDogAy = Mid(InputData, virgul + 1)
TrimDogAy = Trim(MidDogAy)
DogAy = Val(TrimDogAy)

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidDogGun = Mid(InputData, virgul + 1)
TrimDogGun = Trim(MidDogGun)
DogGun = Val(TrimDogGun)

DogTar = DogGun & "." & DogAy

If MyDate1 = DogTar Then

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidDurum = Mid(InputData, virgul + 1)
TrimDurum = Trim(MidDurum)

If TrimDurum = "e" Then
mesMesajBox = " Evlilik Yıldönümü..."
mesSubject = "Evlilik Yıl Dönümünüzü Kutlarım..."
mesBody = "<HTML><H4>Bir Ömür Boyu Mutluluklar...</H4><BODY>demir.zined<br><br></BODY></HTML>"
Else
mesMesajBox = " Doğum Günü..."
mesSubject = "Doğum Gününüzü Kutlarım..."
mesBody = "<HTML><H4>Nice YILLARA...</H4><BODY>demir.zined<br><br></BODY></HTML>"
End If

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidMail = Mid(InputData, virgul + 1)
TrimMail = Trim(MidMail)

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidAdSad = Mid(InputData, virgul + 1)
TrimAdSad = Trim(MidAdSad)

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidSn = Mid(InputData, virgul + 1)
TrimSn = Trim(MidSn)

MailCevap = MsgBox((MyDate1 & " / " & TrimSn & TrimAdSad & mesMesajBox), vbOKCancel, "Mail Gönder!!!")
If MailCevap = 1 Then
Set MyItem = Outlook.CreateItem(olMailItem)
MyItem.To = TrimMail
MyItem.Subject = mesSubject & "(" & TrimAdSad & " - " & MyDate1 & ")"
MyItem.HTMLBody = mesBody
MyItem.Send
End If
End If
Loop
Close #1

End Sub

Private Sub Application_Quit()
On Error Resume Next

Dim Message, Title, Default, MyValue, MyItem
Message = "Kaç gün mesaide olmayacaksınız? (Haftasonu=2)"
Title = "Çıkış"
Default = "2"
MyValue = InputBox(Message, Title, Default)

If MyValue = "" Then
Exit Sub
ElseIf MyValue = 0 Then
Exit Sub
Else
Counter = 0
For Counter = 1 To MyValue
MyDate = Date + Counter
MyDay = Day(MyDate)
MyMonth = Month(MyDate)
MyDate1 = (MyDay & "." & MyMonth)

Open "c:\PersonelOzelGunleri.csv" For Input As #1
Do While Not EOF(1)
Line Input #1, InputData

virgul = InStrRev(InputData, ";", -1)
MidDogAy = Mid(InputData, virgul + 1)
TrimDogAy = Trim(MidDogAy)
DogAy = Val(TrimDogAy)

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidDogGun = Mid(InputData, virgul + 1)
TrimDogGun = Trim(MidDogGun)
DogGun = Val(TrimDogGun)

DogTar = DogGun & "." & DogAy

If MyDate1 = DogTar Then

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidDurum = Mid(InputData, virgul + 1)
TrimDurum = Trim(MidDurum)

If TrimDurum = "e" Then
mesMesajBox = " Evlilik Yıldönümü..."
mesSubject = "Evlilik Yıl Dönümünüzü Kutlarım..."
mesBody = "<HTML><H4>Bir Ömür Boyu Mutluluklar...</H4><BODY>demir.zined<br><br></BODY></HTML>"
Else
mesMesajBox = " Doğum Günü..."
mesSubject = "Doğum Gününüzü Kutlarım..."
mesBody = "<HTML><H4>Nice YILLARA...</H4><BODY>demir.zined<br><br></BODY></HTML>"
End If

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidMail = Mid(InputData, virgul + 1)
TrimMail = Trim(MidMail)

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidAdSad = Mid(InputData, virgul + 1)
TrimAdSad = Trim(MidAdSad)

InputData = Mid(InputData, 1, virgul - 1)
virgul = InStrRev(InputData, ";", -1)
MidSn = Mid(InputData, virgul + 1)
TrimSn = Trim(MidSn)

MailCevap = MsgBox((MyDate1 & " / " & TrimSn & TrimAdSad & mesMesajBox), vbOKCancel, "Mail Gönder!!!")
If MailCevap = 1 Then
Set MyItem = Outlook.CreateItem(olMailItem)
MyItem.To = TrimMail
MyItem.Subject = mesSubject & "(" & TrimAdSad & " - " & MyDate1 & ")"
MyItem.HTMLBody = mesBody
MyItem.Send
End If
End If
Loop
Close #1
Next Counter
End If

End Sub