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.

[Haluk]

EmailItem.SenderName

[tamer42]

Çok Teþekkürler...

Kolay gelsin.

[tamer42]

Merhabalar;

EmailItem.SenderName

bilgisi içerisinde yer alan ve klasör adlandýrmalarýnda kullanýlmayan;

\ / : * ? < > | gibi karakterler gelirse, bu karekterleri EmailItem.SenderName içinden silmenin kýsa (basit) bir yolu varmýdýr?


Çünkü bu tip karakterler gelince , klasör oluþturmada hata veriyor.

Ã?rn: EmailItem.SenderName= aaaa.?bbbbb(c/d) olsun,
yerine aaaa.bbbbb(cd) olarak kabul edecek.


Teþekkür eder, Ýyi Çalýþmalar dilerim.....

[Haluk]

[vb:1:d74e4cd61f]
'.......
'.......
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Ignorecase = True
RegExp.Pattern = "[^\w+@.]"
Gonderen = EmailItem.SenderName
Gonderen = RegExp.Replace(Gonderen , "")
'.....
'.....
[/vb:1:d74e4cd61f]

[tamer42]

Sn Haluk ,

Çok teþekkür ediyorum.

Þimdiden tüm arkadaþlarýn kurban bayramýný kutlarým...