Consulting

Results 1 to 2 of 2

Thread: Find Emails with Attachments

  1. #1

    Find Emails with Attachments

    Hi all,

    I have the following code, it's supposed to find emails in a mailbox with certain attachements and move them to a specific folder. It works for only 1 email before the debugger comes up, you have to end it, and run it again to do the next one, and so on...

    Can anyone see where i'm going wrong?

    Public iItem As Integer
    Option Explicit
    
    
    Sub MovePhotosToFolder()
         
        Dim oItem As MailItem
        Dim FileName As String
        Dim receiveddatetime As String
        Dim objSourceFolder As Outlook.MAPIFolder
        Dim objDestFolder As Outlook.MAPIFolder
        Dim objNS As Outlook.NameSpace
        Dim emailsub As String
        Dim Atts As Attachments
        Dim Att As Attachment
        Dim i As Long
        
        Set objNS = Application.GetNamespace("MAPI")
        Set objSourceFolder = objNS.Folders.item("Mailbox - ****").Folders.item("Inbox")
        Set objDestFolder = objNS.Folders.item("Mailbox - ****").Folders.item("Inbox").Folders.item("Photos")
        
        If objSourceFolder.Items.Count = 0 Then
        MsgBox "No Items selected!", vbCritical, "Error"
        Exit Sub
        End If
        
        For i = objSourceFolder.Items.Count To 1 Step -1
        Set oItem = objSourceFolder.Items(i)
        
        
        receiveddatetime = Format(oItem.ReceivedTime, "yyyy-mm-dd")
        
        
        If InStr(LCase(oItem.Subject), "photo") > 0 Then
        
        Set Atts = oItem.Attachments
        
        If Atts.Count > 0 Then
           For Each Att In Atts
               If InStr(LCase(Att.FileName), "job") > 0 Then
               FileName = "\\****\****\Photos\" & receiveddatetime & "\"
        On Error Resume Next
    
    
        MkDir "\\****\****\Photos\" & receiveddatetime & "\"
        On Error GoTo 0
        
                  Att.SaveAsFile FileName & Att.FileName
                  oItem.Move objDestFolder
                     
               
        End If
        Next
        End If
        End If
        Next
        
         
         
    End Sub
    Last edited by MattehWoo; 07-26-2017 at 07:24 AM. Reason: Added code tags

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    The first problem is you do not have any error trapping, without it you will not necessarily get the correct error message or sometimes none at all.
    So add some error trapping so that you can tell us what has gone wrong with the code.

Posting Permissions

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