Code to only select outlook mails which are unread.

sindhu gollapudi

New Member
Joined
Nov 23, 2020
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
I have below code where the Macro fetches mail from the source folder "Testing". But i want to add another logic where it picks only unread mails

plz help
VBA Code:
Sub Save_Attachments_From_Emails_to_word()
    
    Dim folderPath1, folderpath2 As String
   
    'Check and create folder for the word files that would have the copy of images
    folderPath1 = "C:\OutlookImagesCopy" & Format(Now, "ddMMMyyyyHHMM")
    'Check if the folder exists
    If Dir(folderPath1, vbDirectory) = "" Then
    'Folder does not exist, so create it
    MkDir folderPath1
    Else
    MsgBox ("OutlookImagesCopy folder already exists in the path. Please rename or delete it for the application to work")
    Exit Sub
    End If
   
    'check and create the folder to temporarily save the image copies
    folderpath2 = "C:\OutlookImagesTemp" & Format(Now, "ddMMMyyyyHHMM")
    'Check if the folder exists
    If Dir(folderpath2, vbDirectory) = "" Then
    'Folder does not exist, so create it
    MkDir folderpath2
    Else
    MsgBox ("OutlookImagesTemp folder already exists in the path. Please rename or delete it for the application to work")
    Exit Sub
    End If
   
    'Declare Objects to Refer the Outlook Mailbox
    Dim SourceFolderRef As Outlook.MAPIFolder, SourceMailBoxName As String, Source_Pst_Folder_Name As String
    Dim MailItem As MailItem, MailsCount As Double, atch As Attachment, File_Path As String
   
    'Source Mailbox or PST name
    File_Path = folderpath2 & "\"
    SourceMailBoxName = "mailid"
    Source_Pst_Folder_Name = "testing"
    Set SourceFolder = Outlook.Session.Folders(SourceMailBoxName).Folders(Source_Pst_Folder_Name)
   
    'Loop through Each Email Item in the Folder
    For Each MailItem In SourceFolder.Items
   
        If TypeName(MailItem) = "MailItem" Then
            'Extract & Save Attachments in Email to Folder
            For Each atch In MailItem.Attachments
                If atch.Type = olByValue Then
                    atch.SaveAsFile File_Path & atch.Filename
                End If
            Next atch
        End If
   
    Next MailItem
    'All attachments in the Folder are processed
    MsgBox "Mailes in " & Source_Pst_Folder_Name & " are Processed"

    'Declare objects for word file
    Dim objWord, objDoc, objSelection, pic, picShape As Object


    'Loop through all files in a folder
    Dim fileName1 As Variant
    Dim filename2 As String

    Dim i As Integer
   
    i = 1
    fileName1 = Dir(folderpath2 & "\")


    While fileName1 <> ""
   
    filename2 = folderpath2 & "\" & fileName1
    'open word and copy the images into word files and save them
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    objWord.Visible = True
    Set pic = objDoc.InlineShapes.AddPicture( _
        Filename:=filename2, _
        LinkToFile:=False, _
        SaveWithDocument:=True _
    )
    Set picShape = pic.ConvertToShape
    objDoc.SaveAs ("C:\OutlookImagesCopy" & "\" & "Doc" & i)
    objWord.Quit
    Set objWord = Nothing
    i = i + 1
    'Set the fileName to the next file
    fileName1 = Dir
   
    Wend

    folderpath2 = folderpath2 & "\"
    Kill folderpath2 & "*.*"
   
    RmDir folderpath2

MsgBox ("All images saved into different word files")

End Sub
 
Last edited by a moderator:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Then you need to add one If /En Di level, as follows:
VBA Code:
For Each MailItem In SourceFolder.Items
    If TypeName(MailItem) = "MailItem" Then
        If MailItem.UnRead Then                                 '+++ Check if unread
            'Extract & Save Attachments in Email to Folder
            For Each atch In MailItem.Attachments
                If atch.Type = olByValue Then
                    atch.SaveAsFile File_Path & atch.Filename
                End If
            Next atch
        End If                                                  '+++ end if
    End If
Next MailItem
The added instrunctions are marked +++

BUT MY SUGGESTION is that you process emails and then move them to a separate subfolder.
That is:
1) you create a subfolder in your working folder, and call it (for example) "Processed"
2) then you use this code:
VBA Code:
For Each MailItem In SourceFolder.Items
    If TypeName(MailItem) = "MailItem" Then
        'Extract & Save Attachments in Email to Folder
        For Each atch In MailItem.Attachments
            If atch.Type = olByValue Then
                atch.SaveAsFile File_Path & atch.Filename
            End If
        Next atch
    End If
    MailItem.Move SourceFolder.Folders("Processed")      '<<< move processed emails
Next MailItem

The added line, with respect to your current code, is the one marked <<<

I find a little bit confusing and error prone using a variable (MailItem) that is also a type of object; maybe using myMail (as MailItem) would be more appropriate.

Bye
 
Upvote 0
Solution
Then you need to add one If /En Di level, as follows:
VBA Code:
For Each MailItem In SourceFolder.Items
    If TypeName(MailItem) = "MailItem" Then
        If MailItem.UnRead Then                                 '+++ Check if unread
            'Extract & Save Attachments in Email to Folder
            For Each atch In MailItem.Attachments
                If atch.Type = olByValue Then
                    atch.SaveAsFile File_Path & atch.Filename
                End If
            Next atch
        End If                                                  '+++ end if
    End If
Next MailItem
The added instrunctions are marked +++

BUT MY SUGGESTION is that you process emails and then move them to a separate subfolder.
That is:
1) you create a subfolder in your working folder, and call it (for example) "Processed"
2) then you use this code:
VBA Code:
For Each MailItem In SourceFolder.Items
    If TypeName(MailItem) = "MailItem" Then
        'Extract & Save Attachments in Email to Folder
        For Each atch In MailItem.Attachments
            If atch.Type = olByValue Then
                atch.SaveAsFile File_Path & atch.Filename
            End If
        Next atch
    End If
    MailItem.Move SourceFolder.Folders("Processed")      '<<< move processed emails
Next MailItem

The added line, with respect to your current code, is the one marked <<<

I find a little bit confusing and error prone using a variable (MailItem) that is also a type of object; maybe using myMail (as MailItem) would be more appropriate.

Bye
Hey Anthony, It works perfectly now. Thanks a Ton :D
 
Upvote 0

Forum statistics

Threads
1,223,237
Messages
6,170,928
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top