Forum
Bildirimler
Hepsini Temizle
Microsoft Office
23
Yazılar
4
Üyeler
0
Likes
4,145
Görüntüleme
Bence süper olmuş eline sağlık.
Danışman - ITSTACK Bilgi Sistemleri
****************************************************************
Probleminiz Çözüldüğünde Sonucu Burada Paylaşırsanız.
Sizde Aynı Problemi Yaşayanlar İçin Yardım Etmiş Olursunuz.
Eğer sorununuz çözüldü ise lütfen "çözüldü" olarak işaretlerseniz diğer üyeler için çok büyük kolaylık sağlayacaktır.
*****************************************************************
Gönderildi : 14/07/2012 00:32
Konu başlatıcı
Soner kardeşim (veya abim);
Şu an kullandığım (benim için şu an yeterli olan) kod;
Option Explicit
Public WithEvents postakutum As Outlook.Items
Public Sub Application_Startup()
Set postakutum = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("uydu").Items
End Sub
Private Sub postakutum_ItemAdd(ByVal Item As Object)
Dim cevaplayici As MailItem
If TypeName(Item) = "MailItem" Then
Dim objOutlook As Object
Dim objOutlookMsg As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
.To = "[email protected]"
.Subject = "mail geldi..."
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End If
End Sub
Bu kod süper oldu. Bir gemi için, geminin kara ofisinde kullandım.
Bu kod, eğer gemi sahibinin sadece bir gemisi varsa geçerli.
Şimdi ricam, eğer mümkünse gemi sahibinin iki ve daha fazla gemisine (farklı adreslere) mesaj atacak şekilde nasıl genişletiriz;
Örneğin; outlook ta gelen kutusuna uydu, uydu1, uydu2, uydu3 diye 4 adet klasör oluşturdum. 4 farklı geminin outlook ayarlarını yaptım ve her gemi için gelen mesaj o klasöre düşüyor. ([email protected] dan gelen mesaj uydu klasörüne; [email protected] adresinden gelen mesaj uydu1 kasörüne düşüyor.)
Buraya kadar sorun yok.
Sorun [email protected] adresinden gelen mesaj uydu klasörüne düştü ve yazdığın kod [email protected] adresine mesaj attı. ok.
[email protected] adresine bir mesaj düştü ve ben [email protected] adresine mesaj atmasını istiyorum.
[email protected] adresine bir mesaj düştü ve ben [email protected] adresine mesaj atmasını istiyorum. gibi.
Bu şekilde kısaca;
uydu klasörüne mesaj düşünce [email protected] adresine ; uydu1 klasörüne mesaj düşünce [email protected] adresine mesaj atacak şekilde nasıl yapılandırılabilir?
Kod u copy-past yapıp ( Folders("uydu").Items adresteki uydu yerine uydu1 ve to: adresini değiştirmem olabilir mi?
Yardımlarınız için çok teşekkür ederim.
Saygılarımla.
İnşallah çikolatamı beğenmişsinizdir.
Teşekürler Hakan, Düzenlenmiş halini yazıyorum :). Program Belirtilen outlook klasorune mail düştüğü zaman , belirlenen mail adresine " Mail Geldi" diye mail atıyor. Eğer mailde Ekli dosya var ise bunları winrar ile sıkıştırıp maile ekleyip belirlenen maile atmaktadır.
'***************************************************************************************
'C:\comp_ek klasörü mutlaka oluşturulmalıdır. Sıkıştırma işlemi bu klasörde yapılır.
'C:\mail klasörü mutlaka oluşturulmalıdır. Mail ekleri bu klasore kayıt edilir.
'Bilgisayarda winrar kurulu olmalıdır.
'sonerkoca28@gmail adresi yerine mailin iletileceği adres yazılmalıdır.
'***************************************************************************************
'//////////////////////////////////////////Soner KOCA /////////////////////////////////////
'//////////////////////////////////////////[email protected]///////////////////////////
Option Explicit
Public WithEvents postakutum As Outlook.Items
Dim sayici As Integer
Const dosya_yolu As String = "C:\Comp_ek\"
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Application_Startup()
Dim ns As Outlook.NameSpace
sayici = 0
Set postakutum = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("Yazilim").Items
End Sub
Sub postakutum_ItemAdd(ByVal Item As Object)
Dim ekli_dosya As Attachment
Dim i As Integer
Dim sikistirma_programi As String
Dim cevaplayici As MailItem
Dim ziple As String
Dim kaynak As String
Dim hedef As String
Dim outlk1 As Object
Dim outlk2 As Object
On Error Resume Next
Kill "c:\mail\*.*"
Kill "c:\comp_ek\*.*"
If TypeName(Item) = "MailItem" Then
sayici = sayici + 1
Set outlk1 = CreateObject("Outlook.Application")
Set outlk2 = outlk1.CreateItem(0)
With outlk2
.To = "[email protected]"
.Subject = "mail geldi " & sayici
If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set ekli_dosya = Item.Attachments(i)
kaynak = ""
ekli_dosya.SaveAsFile "c:\mail\" & ekli_dosya.FileName
sikistirma_programi = "C:\Program files\winrar\"
kaynak = "c:\mail\" & ekli_dosya.FileName
hedef = "c:\comp_ek\ekler.rar"
Next
End If
ziple = Shell(sikistirma_programi & "rar a " & hedef & " " & "c:\mail", vbNormalFocus)
Sleep 1000
outlk2.Attachments.Add ("c:\comp_ek\ekler.rar")
outlk2.Send
End With
Set outlk2 = Nothing
Set outlk1 = Nothing
End If
Set ekli_dosya = Nothing
End Sub
Gönderildi : 08/08/2012 02:38
Can aşağıdaki kodu yazarak bahse konu klasorlere mail dustugunde ilgili adreslere mail gönderimi yapabilirsin.
Option Explicit
Public WithEvents postakutum As Outlook.Items
Public WithEvents postakutum1 As Outlook.Items
Public WithEvents postakutum2 As Outlook.Items
Public Sub Application_Startup()
Set postakutum = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("uydu").Items
Set postakutum1 = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("uydu1").Items
Set postakutum2 = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("uydu2").Items
End Sub
Private Sub postakutum_ItemAdd(ByVal Item As Object)
Dim cevaplayici As MailItem
If TypeName(Item) = "MailItem" Then
Dim objOutlook As Object
Dim objOutlookMsg As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
.To = "[email protected]"
.Subject = "mail geldi..."
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End If
End Sub
Private Sub postakutum1_ItemAdd(ByVal Item As Object)
Dim cevaplayici As MailItem
If TypeName(Item) = "MailItem" Then
Dim objOutlook As Object
Dim objOutlookMsg As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
.To = " [email protected]"
.Subject = "mail geldi..."
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End If
End Sub
Private Sub postakutum2_ItemAdd(ByVal Item As Object)
Dim cevaplayici As MailItem
If TypeName(Item) = "MailItem" Then
Dim objOutlook As Object
Dim objOutlookMsg As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
.To = " [email protected]"
.Subject = "mail geldi..."
.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End If
End Sub
Gönderildi : 13/08/2012 14:56
Konu başlatıcı
Teşekkür ederim.
Şu anda deneyebileceğim ekipman ve sistemim yok (Fakat tam düşündüğüm gibi olmuş)
Saygılarımla.
Gönderildi : 13/08/2012 19:37
Sayfa 2 / 2
Önceki
