Outlookta Gelen Maili Kopyalama

[ozgurpeh]

Merhaba,

Outlook ta düzenli olarak gelen bir mailin excell ekini bir çalışma sayfasına otomatik olarak nasıl aktarabileceğimiz konusunda yardımınıza ihtiyaç duymaktayım

 

[ozgurpeh]

Sub deneme()
Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set colItems = objFolder.Items
On Error Resume Next
For Each objMessage In colItems
DoEvents
If objMessage.ReceivedTime >= Now - 1 And objMessage.ReceivedTime <= Now Then
If Err Then Err.Clear: GoTo a
If objMessage.Subject = "mailin konusu" Then
intCount = objMessage.Attachments.Count
If intCount > 0 Then
For i = 1 To intCount
dosya = objMessage.Attachments.Item(i).FileName
c = Split(dosya, ".")(1)
If c = "xlsx" Or c = "xlsm" Or c = "xls" Then
objMessage.Attachments.Item(i).SaveAsFile "Z:\deneme\" & dosya
End If
Next i
End If
End If
End If
a: Next objMessage
Set objOutlook = Nothing: Set objNamespace = Nothing: Set objFolder = Nothing
Set colItems = Nothing: Set objMessage = Nothing: intCount = Empty: i = Empty
End Sub



Böyle bir örnek buldum fakat son 1 saat içerisinde gelen maili alacak şekilde nasıl düzenleme yapılabilir yardımcı olabilcek var mı ?