- Katılım
- 24 Ekim 2007
- Mesajlar
- 98
- Excel Vers. ve Dili
- 2007 türkçe
- Altın Üyelik Bitiş Tarihi
- 23.11.2018
arkadaşlar, outlookda otomatik mail için forumda bulduğum aşağıdaki formülü kullanıyorum. Buradaki kutlama mesajları (metinler) yerine resim eklenebilir mi?
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:\Users\berkant.ozenc\Desktop\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>Hüner Pazarlama ve Tic. A.Ş.<br><br></BODY></HTML>"
Else
mesMesajBox = " Doğum Günü..."
mesSubject = "Doğum Gününüzü Kutlarım..."
mesBody = "<HTML><H4>Doğum gününüzü en içten dileklerimizle kutlar; sevdiklerinizle birlikte sağlık, huzur ve mutluluk dolu nice seneler dileriz...</H4><BODY>Hüner Pazarlama ve Tic. A.Ş.<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:\Users\berkant.ozenc\Desktop\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>Hüner Pazarlama ve Tic. A.Ş.<br><br></BODY></HTML>"
Else
mesMesajBox = " Doğum Günü..."
mesSubject = "Doğum Gününüzü Kutlarım..."
mesBody = "<HTML><H4>Doğum gününüzü en içten dileklerimizle kutlar; sevdiklerinizle birlikte sağlık, huzur ve mutluluk dolu nice seneler dileriz...</H4><BODY>Hüner Pazarlama ve Tic. A.Ş.<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
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:\Users\berkant.ozenc\Desktop\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>Hüner Pazarlama ve Tic. A.Ş.<br><br></BODY></HTML>"
Else
mesMesajBox = " Doğum Günü..."
mesSubject = "Doğum Gününüzü Kutlarım..."
mesBody = "<HTML><H4>Doğum gününüzü en içten dileklerimizle kutlar; sevdiklerinizle birlikte sağlık, huzur ve mutluluk dolu nice seneler dileriz...</H4><BODY>Hüner Pazarlama ve Tic. A.Ş.<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:\Users\berkant.ozenc\Desktop\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>Hüner Pazarlama ve Tic. A.Ş.<br><br></BODY></HTML>"
Else
mesMesajBox = " Doğum Günü..."
mesSubject = "Doğum Gününüzü Kutlarım..."
mesBody = "<HTML><H4>Doğum gününüzü en içten dileklerimizle kutlar; sevdiklerinizle birlikte sağlık, huzur ve mutluluk dolu nice seneler dileriz...</H4><BODY>Hüner Pazarlama ve Tic. A.Ş.<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