Personel & Zimmet Takip Programı (KZT-v.5) foruma eklenmiştir. 
http://www.excelce.net/forum/index.php?topic=1676.0

Gönderen Konu: Outlook Açıldığında Excel'deki Listeye Özel Günlerinde Mail,  (Okunma sayısı 6804 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı demir.zined

  • Excelce Onbaşı
  • **
  • İleti: 4
  • Puan +1/-0
  • Cinsiyet: Bay
  • Excel'den Daha Fazlası!..
  • Ad Soyad: demir zined
  • Doğum Yılınız: 1982
  • İl / İlçe: istanbul
  • Mesleğiniz: memur
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