Results 1 to 1 of 1
  1. #1
    Lounger
    Join Date
    Aug 2013
    Posts
    45
    Thanks
    11
    Thanked 0 Times in 0 Posts

    Move mail from Inbox after download of attachment

    Hello,
    I have Win 7, Outlook 2013 & below codes are downloading the attachments perfectly, Please someone help me to schedule this macro to run every 10 minutes.

    Code:
    Sub GetAttachments() 
        On Error Goto GetAttachments_err 
        Dim ns As NameSpace 
        Dim Inbox As MAPIFolder 
        Dim Item As Object 
        Dim Atmt As Attachment 
        Dim FileName As String 
        Dim i As Integer 
        Set ns = GetNamespace("MAPI") 
        Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
        i = 0 
        If Inbox.Items.Count = 0 Then 
              MsgBox "There are no messages in the Inbox.", vbInformation, _
             "Nothing Found" 
            Exit Sub 
        End If 
        For Each Item In Inbox.Items 
            For Each Atmt In Item.Attachments 
                If UCase(Atmt.FileName) Like "Presentation1*" Or _ 
                UCase(Atmt.FileName) Like "Export*" Or _ 
                UCase(Atmt.FileName) Like "Import*" Then 
                    FileName = "D:\Attachments\" & Atmt.FileName 
                    Atmt.SaveAsFile FileName 
                    i = i + 1 
                End If 
            Next Atmt 
        Next Item 
        If i > 0 Then 
              MsgBox "I found " & i & " attached files." _
             & vbCrLf & "I have saved them into the D:\Attachments folder." _ 
            & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!" 
        Else 
               MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
         End If 
    GetAttachments_exit: 
        Set Atmt = Nothing 
        Set Item = Nothing 
        Set ns = Nothing 
        Exit Sub 
    GetAttachments_err: 
          MsgBox "An unexpected error has occurred." _
         & vbCrLf & "Please note and report the following information." _ 
        & vbCrLf & "Macro Name: GetAttachments" _ 
        & vbCrLf & "Error Number: " & Err.Number _ 
        & vbCrLf & "Error Description: " & Err.Description _ 
        , vbCritical, "Error!" 
        Resume GetAttachments_exit 
    End Sub
    Last edited by foncesa; 2013-08-30 at 00:53.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •