Outlook içerisinde resim izleme

[tamer42]

Merhabalar;

Outlook' ta Inbox' a gelen mail mesajlarında;

Herhangi bir mail içerisine eklenmiş olan resimlere bakmak için tek tek açmak gerekiyor,

Yada bir klasöre kaydedip burada izlemek bir başka çözümdür.

Ben bunların dışında daha kolay bir yol arıyorum; Eklenmiş resimlere Outlook içerisinde XP' nin resim izleme özelliği gibi pratik bir bakma yöntemi varmıdır,

bu konuda paratik yöntemler bilen arkadaşlar varsa; bunu paylaşırlarsa sevinirim,


İyi Çalışmalar dilerim....

 

[Haluk]

.....
Yada bir klasöre kaydedip burada izlemek bir başka çözümdür
.....

Merhaba;

Yukarıdaki alıntıda belirtilen işi, yani resim olan ekleri bir klasöre kaydetme işini yapacak olan ve MS Outlook altında çalışacak bir VBA kodu hazırladım.

Bu kodun yaptığı iş; MS Outlook programını kullanıyorsanız eğer, kodlarda tanımlanmış olan uzantılara (bmp, jpg, gif, wmf) sahip herhangibir ataçlı e-mail geldiği anda, kullanıcının MasaUstunde otomatik olarak PicFolder isimli bir klasör oluşturulacak ve aşağıdaki resimde de belirtildiği gibi, bu klasörün içine de dd.mm.yyyy hh-mm-ss formatında gelen e-mailin tarih ve saatinin adlandırıldığı alt klasörler oluşturulup, ilgili resim dosyaları bu alt klasörler içine yerleştirilecektir.


Kodları yerleştirmek için, MS Outlook programını açtıktan sonra ALT + F11 tuşlarına birlikte basarak VBE kısmına geçtikten sonra kodları buradan kopyalayıp ThisOutlookSession modülünün içine yapıştırmanız gerekir.

Daha sonra, denemek için örneğin kendi e-mail adresinize bir resim dosyası gönderebilirsiniz.

İlgili kodlar aşağıdadır;

[vb:1:5b68b56cb2]Private Type SHITEMID
cb As Long
abID As Byte
End Type
'
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
'
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Const CSIDL_PERSONAL = &H0
'
Private Sub Application_NewMail()
Dim MyDeskTopPath As String
Dim MyPicFolder As String
Dim NameSpc As NameSpace
Dim MyInbox As MAPIFolder
Dim EmailItem As Object
Dim Atch As Attachment
Dim RecFolder As String, TempDir As String
Dim ExtArr(3) As String
Dim j As Byte

ExtArr(0) = "bmp"
ExtArr(1) = "jpg"
ExtArr(2) = "gif"
ExtArr(3) = "wmf"

MyDeskTopPath = GetSpecialfolder(CSIDL_PERSONAL)
MyPicFolder = MyDeskTopPath & "\" & "PicFolder"

Set NameSpc = GetNamespace("MAPI")
Set Inbox = NameSpc.GetDefaultFolder(olFolderInbox)
For Each EmailItem In Inbox.Items
If EmailItem.UnRead Then
If Not FolderExists(MyPicFolder) Then MkDir MyPicFolder
TempDir = MyPicFolder & "\" & _
Format(EmailItem.ReceivedTime, "dd.mm.yyyy hh-mm-ss")
For Each Atch In EmailItem.Attachments
For j = 0 To 3
If LCase(Right(Atch.FileName, 3)) = LCase(ExtArr(j)) Then
If Not FolderExists(TempDir) Then
MkDir TempDir
End If
Atch.SaveAsFile TempDir & "\" & Atch.FileName
End If
Next
Next
End If
Next

Set NameSpc = Nothing
Set Inbox = Nothing
End Sub
'
Private Function GetSpecialfolder(CSIDL As Long) As String
Dim r As Long
Dim Path$
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path$, InStr(Path$, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
'
Private Function FolderExists(aFolder As String) As Boolean
Set FSO = CreateObject("Scripting.FileSystemObject")
FolderExists = FSO.FolderExists(aFolder)
End Function
[/vb:1:5b68b56cb2]

 

[tamer42]

Sn Raider,

Bu kadar uzun bir kod yazmak için ayırdığınız zaman ve emek için Size çok teşeşkkür ediyorum.


Oulook kodlarıyla ilgili faydalı olacağını bildiğiniz bir döküman veya kaynak varmıdır ?

Kolay gelsin.

 

[Haluk]

Oulook kodlarıyla ilgili faydalı olacağını bildiğiniz bir döküman veya kaynak varmıdır ?

http://www.excel.web.tr/viewtopic.php?p=19652#19652

 

[tamer42]

Sn Raider;

Buradaki kodlar ilk geldiğimde çalışmıştı,

o günden sonra gelen ekli resim dosyaların ilgili klasöre kopyalanmadığını gördüm.

bu neden kaynaklanabilir.

Selamlar, Kolay gelsin.

 

[Haluk]

bu neden kaynaklanabilir.

Bence;

1) Yukarıdaki kodun silinmediğinden emin olun,

2) MS Outlook'u açarken, makroları etkinleştirerek açın,

3) Gelen resim dosya uzantılarının bmp, jpg, gif veya wmf olduğundan emin olun.

 

[tamer42]

Merhabalar,

Sn Raider;

bu neden kaynaklanabilir.

Uzun zamandır buna kafa yoruyordum, sonunda çözdüm.

Eğer Outlook kapalı ise bu süreçte gelen ekli dosyaları kaydetmiyor, sadece Outlook açık iken gelenleri kaydediyor.

Bu normal bir durum olabilir, yalnız Outlook açıldığı zaman tarayıp; kapalı olduğu zamandaki gelen mesajlarda (unread) yer alan ekli dosyayları bu şekilde kaydetmesini sağlayamazmıyım?

Saygılar, İyi çalışmalar....

 

[Haluk]

Outlook açıldığı zaman tarayıp; kapalı olduğu zamandaki gelen mesajlarda (unread) yer alan ekli dosyayları bu şekilde kaydetmesini sağlayamazmıyım?

Zaten, yukarıda verdiğim kodlar bu mantıkla çalışmaktadır...

.....
....
If EmailItem.UnRead Then
If Not FolderExists(MyPicFolder) Then MkDir MyPicFolder
TempDir = MyPicFolder & "\" & _
...
..

 

[tamer42]

Merhabalar,


Buradaki asıl öğrenmek istediğim,

Eğer Outlook kapalı ise bu süreçte gelen ekli dosyaları kaydetmiyor, sadece Outlook açık iken gelenleri kaydediyor.

idi.

Outlook ilk açıldığı zaman; bu mesajlar zaten (unread) pozisyonundadır, bunu bilgi amaçlı yazmıştım.

İyi Çalışmalar.

 

[Haluk]

Tamer bey Outlook programı kapalı iken normal olarak, gelen mailleri inceleme imkanımız yok tabii.

Bu nedenle, açıldıktan sonra bu işi yapabiliyoruz.

Ama direkt olarak "mail server" ile ilişkiye geçen bir kod yazılabilir mi derseniz, onu bilemem ama biraz Excel'in dışında bir olay gibi geliyor bana.

Belki onun da bir yolu vardır.

 

[Exelans]

Sn Raider,
kodları ben de deniyorum. Kendime email atıyorum. Mail gelince resim varsa onu dosyaya atıyor. Ancak okundu bilgisi geldiğinde aşağıdaki satırda hata veriyor.
Baktım ama çözemedim. Yardımcı olurmusun ?
TempDir = MyPicFolder & "\" & _
Format(EmailItem.ReceivedTime, "dd.mm.yyyy hh-mm-ss")

 

[Haluk]

Merhaba;

Þu anda MS Outlook olmadığı için maalesef bir şey diyemeyeceğim, umarım yarın bakabilirim.

Ancak, bir IF kontrolu ile sorunu aşabilirsiniz gibi geliyor.

 

[Exelans]

[vb:1:17b0e7d283]For Each EmailItem In Inbox.Items
If EmailItem.UnRead Then
If Not FolderExists(MyPicFolder) Then MkDir MyPicFolder
For Each Atch In EmailItem.Attachments
For j = 0 To 3
If LCase(Right(Atch.FileName, 3)) = LCase(ExtArr(j)) Then
'..................................................
TempDir = MyPicFolder & "\" & Format(EmailItem.ReceivedTime, "dd.mm.yyyy hh-mm-ss")
'.....................................................
If Not FolderExists(TempDir) Then MkDir TempDir
Atch.SaveAsFile TempDir & "\" & Atch.FileName
End If
Next
Next
End If
Next[/vb:1:17b0e7d283]
Kodlarda işaretli yeri buraya aldınca düzeldi. Teşekkürler. Eline sağlık.

 

[Haluk]

Kodlarda işaretli yeri buraya aldınca düzeldi. Teşekkürler. Eline sağlık.

Rica ederim, problemi siz kendiniz çözmüşünüz. Başka ilgilenenlere de yardımcı olacaktır. Esas, ben teşekkür ederim.

 

[ferhatpeker]

bence incredimail adlı bir program var bunu kullanırsan ekleride otomatik olarak görürsün hemde eğlenceli bir program tabi istersen google ile arattırırsan ehemn karşına çıkacaktır. Crack te buldunmu işte sana bedava güzel bir program...

eminim beğeneceksin...

 

[tamer42]

Sn Ferhatpeker ilginize teşekkürler... Tüm arkadaşlara da merhabalar,

Sizin burada bahsettiğiniz anladığım kadarıyla farklı bir mail proğramı.

Ben uzun yıllardır Outlook kullanıyorum, Yukarıdaki kodlar bu konuda işimi görüyor, bir farkla; Akşam giderken Bilgisayar ile birlikte doğal olarak Outlook' uta kapatıyorum.

"Sabah gelip Outlook' u açtığımda bilgisayarın (Outlook'un) kapalı olduğu süreçte gelen mailleri tarayıp (unread) , bu sırada varsa eklerin bahsedilen klasöre yüklenmesi"

Selamlar. İyi çalışmalar..

 

[Haluk]

"Sabah gelip Outlook' u açtığımda bilgisayarın (Outlook'un) kapalı olduğu süreçte gelen mailleri tarayıp (unread) , bu sırada varsa eklerin bahsedilen klasöre yüklenmesi"

Daha öncede aynı şeyi belirtmiştiniz ama, kodlar bahsettiğiniz işi aynen yapmaktadır.

Yani, sabah gelip de MS Outlook'u açtığınızda "UnRead" durumdaki bütün mailleri tarar ve ilgili işlemleri yapar.

 

[tamer42]

Merhaba;

Private Sub Application_Startup()
Call Application_NewMail
End Sub

yazınca sorun halloldu,

İyi Akşamlar....

 

[Haluk]

Sanırım, siz MS Outlook' da ayrıca bir "Personal Folder" yaratmadınığınız için bu sorunla karşılaşıyordunuz.

Sorunun giderildiğine sevindim.

 

[tamer42]

Merhabalar,

'..................................................
TempDir = MyPicFolder & "\" & Format(EmailItem.ReceivedTime, "dd.mm.yyyy hh-mm-ss")
'.....................................................

Burada TempDir= içeriğine e-mail ' i gönderenin adını bir şekilde dahil etmek istiyorum.

Ã?rnek:
E-mail, from: aaaa.bbbbb@..................com adresinden gelsin, aaaa.bbbbb ifadesinininde belirleyici olarak yer almasını istiyorum.

EmailItem.ReceivedTime gibi, EmailItem.??????????
ne olması gerekir.

Yardımcı olacak arkadaşlara şimdiden teşekkürler...

İyi Çalışmalar dilerim.