Outlook eklerini klasöre kaydetme

[arrow3441]

Merhaba üstadlar excel makro ile dün tarihli gelen maillerin gönderen kişilerin maillerini a sütununa yazarak sadece o kişilerden gelen mail eklerini sadece .xls olanları masaüstündeki klasöre kaydetmek istiyorum. Yardımcı olursanız çok sevinirim

 

[muhasebeciyiz]

Sub Deneme()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim strSender As String
Dim strSavePath As String
Dim att As Outlook.Attachment

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olInbox = olNs.GetDefaultFolder(olFolderInbox)

Set olItems = olInbox.Items.Restrict("[ReceivedTime] >= '" & Format(Date - 1, "dd.mm.yyyy") & "' AND [ReceivedTime] < '" & Format(Date, "dd.mm.yyyy") & "'")

For Each olItem In olItems
strSender = olItem.SenderName
strSavePath = "C:\Users\Kullanıcı Adı\Desktop\Klasör Adı\" & strSender

If Dir(strSavePath, vbDirectory) = "" Then
MkDir strSavePath
End If

For Each att In olItem.Attachments

If Right(att.FileName, 4) = ".xls" Or Right(att.FileName, 5) = ".xlsx" Then
att.SaveAsFile strSavePath & "\" & att.FileName
End If
Next att
Next olItem

MsgBox "İşlem tamamlandı!"
End Sub

 

[arrow3441]

Teşekkür ederim hocam strAttachment for Each control variable must be Variant or Object hatası verdi

 

[arrow3441]

Dim **att As Object** sytanx error verdi

 

[arrow3441]

Type Mismatch hatası verdi hocam

 

[arrow3441]

Çalıştı hocam çok teşekkür ederim ilginize emeğinize