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:

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
1,969
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
 
Solution

sindhu gollapudi

New Member
Joined
Nov 23, 2020
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,209
Messages
5,570,911
Members
412,348
Latest member
NATTS
Top