Outlook - Gelen Maildeki Excel Dosyalarını Masaüstüne Kaydet

Gelen mailde bir [b]Excel[/b] dosyası var ise, o dosyayı masaüstüne kaydetmek için bu kodları kullanabilirsiniz; 

Sub Gelen_Maildeki_Excel_Dosyalarını_Masaüstüne_Al()
    Dim objFolder As Outlook.MAPIFolder, objNS As Outlook.Namespace
    Dim objItem As Outlook.MailItem, i As Integer, yol As String
    Set objNS = Application.GetNamespace("MAPI")
    Set objFolder = objNS.Folders("Kişisel Klasörler").Folders("Gelen Kutusu").Folders("Klasör Adını Yazın")
    yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    For Each objItem In objFolder.Items
        If objItem.UnRead = True Then
            For i = 1 To objItem.Attachments.Count
                If Right(objItem.Attachments.Item(i).Filename, 4) = "xlsx" Then
                    MsgBox objItem.Attachments.Item(i).Filename
                    objItem.Attachments.Item(i).SaveAsFile yol & objItem.Attachments.Item(i).Filename
                End If
            Next i
        End If
    Next
    Set objItem = Nothing: Set objFolder = Nothing
    Set objNS = Nothing: i = Empty: yol = vbNullString
End Sub

[b]Not:[/b] Referanslardan Microsoft Outlook XX.0 Object Library referansını seçin.

Hoşça kalın !